ETO Development Tools 2/ETO Development Tools 2.iso/Tools - Objects/MacApp/MacApp CD Release/MacApp 2.0.1 (Many Libraries)/Libraries/UDebug.inc1.p

Text File | 1990-10-25 | 116.6 KB | 4,754 lines | [TEXT/MPS ]

{$P}
{[a-,body+,h-,o=100,r+,rec+,t=4,u+,#+,j=20/57/1$,n-]}
{ UDebug.inc1.p }
{ Copyright © 1985-1990 by Apple Computer, Inc.  All rights reserved. }

{ NMI catcher does not work... probably an A-trap is lowering the priority level }
{ Meanwhile, the user can use NMI to get to underlying debuggers (MacsBug, etc.) }

{$IFC NOT qDebugTheDebugger}
{$W+}
{$R-}
{$Init-}
{$OV-}
{$ENDC}
{$IFC qNames}
{$D+}
{$ENDC}

{$IFC UNDEFINED IncludeDisassembler}
{$SETC IncludeDisassembler := FALSE}                    { Don't automatically include in this version }
{$ENDC}

CONST
    kDebugWindowType    = 901;

    kHelpRequest        = '?';
    kDontKnow            = ' Huh? ';

    kReserve            = 500;                            { Heap space reserved for the debugger's
                                                         use. Too much?, Too little? }
    kRecent             = 63;                            { must be a power of 2 minus 1 }

    kDebugSICN            = 901;                            { SICN given to MN }
    { 68000 exception numbers that we intercept }
    exBusError            = 2 * sizeof(Longint);
    exAddressError        = 3 * sizeof(Longint);
    exIllegalInst        = 4 * sizeof(Longint);
    exZeroDivide        = 5 * sizeof(Longint);
    exCheck             = 6 * sizeof(Longint);
    exOverflow            = 7 * sizeof(Longint);
    exLineF             = 11 * sizeof(Longint);

TYPE

    IEFilePath            = STRING;
    IEFilePathPtr        = ^IEFilePath;

    IEFRefNum            = Longint;
    {---}
    ZT                    = (tBegin, tEnd, tExit, tBeginEndPair, { the rest always stop }
                           tProgBreak, tSysError, tVBL, tReadLn);
    ProcPtrPtr            = ^ProcPtr;

    HexAddress            = STRING[16];                    { Usually 8-9 chars. Sometimes a _small_
                                                         string constant though. }

    QElemWithA5         = RECORD
        OldA5:                Longint;                    { A place to store the old value of A5 since
                                                         when debugging the compiler trashes the
                                                         value of A0 for any locals in the VBL task
                                                         thus makeing the pointer to the
                                                         paramblockrec unavailable }
        A5:                 Longint;                    { The value of A5 will be stored here to be
                                                         available at VBL time }
        q:                    QElem;                        { vbl queue element for changing the cursor}
        END;

    VBLInfoPtr            = ^VBLInfo;
    VBLInfo             = RECORD
        aQElemWithA5:        QElemWithA5;                { vbl queue element for changing the cursor
                                                         }
        ch:                 CHAR;                        { character to represent the flag to the
                                                         user with }
        actionProc:         ProcPtr;                    { Pointer to a Proc that takes a boolean. If
                                                         action is required when setting flag }
        desc:                StringHandle;                { a description of the flag's function }
        END;

    DebugFEntry         = RECORD
        addr:                BooleanPtr;                 { Pointer to the actual boolean used for the
                                                         flag }
        ch:                 CHAR;                        { character to represent the flag to the
                                                         user with }
        actionProc:         ProcPtr;                    { Pointer to a Proc that takes a boolean. If
                                                         action is required when setting flag }
        desc:                StringHandle;                { a description of the flag's function }
        END;

    DebugSEntry         = RECORD
        addr:                Ptr;
        actionProc:         ProcPtr;                    { Pointer to a Function that returns a Ptr.
                                                         If action is required to get addr (pass
                                                         nil for addr) }
        sym:                MAName;
        END;

    RecentPC            = RECORD
        thePC:                Longint;
        theZT:                ZT;
        END;

    SavedState            = RECORD
        pFocusRec:            FocusRec;                    { Place to stow focus behind MacApp's back }

        SaveVisRgn:         RgnHandle;                    { Place to stow the lo-mem save of the
                                                         Vis-Rgn during the Update sequence }
        gCursorRgn:         RgnHandle;                    { the global cursor region }
        gTarget:            TEvtHandler;
        gClickCount:        INTEGER;
        gErrorParm3:        Str255;
        gEventLevel:        INTEGER;
        gIdlePhase:         IdlePhase;
        gInBackground:        BOOLEAN;
        gLastClickPart:     INTEGER;
        gLastDeskAcc:        Longint;
        gLastMsePt:         Point;
        gLastUpTime:        Longint;
        gMainEventMask:     INTEGER;
        gApplication:        TApplication;                { place to stow the application behind
                                                         MacApp's back }
        gBusyTempRgn:        BOOLEAN;
        gUsedBy:            Str255;
        gTempRgn:            RgnHandle;

        gIntenseDebugging:    BOOLEAN;
        gDebugPrinting:     BOOLEAN;
        END;

    HideType = (RawHide, PartialHide, FullHide);

    {$IFC qDebug}
    TDebugApplication    = OBJECT (TApplication)         { Main Event Handler for debug mode, not for
                                                         tracing. }
        PROCEDURE TDebugApplication.IDebugApplication;
        FUNCTION TDebugApplication.DoMenuCommand(aCmdNumber: CmdNumber): TCommand; OVERRIDE;
        FUNCTION TDebugApplication.WMgrToWindow(aWMgrWindow: WindowPtr): TWindow; OVERRIDE;
        FUNCTION TDebugApplication.MenuEvent(menuItem: Longint): TCommand; OVERRIDE;
        FUNCTION TDebugApplication.HandleMouseDown(VAR theEventInfo: EventInfo): TCommand; OVERRIDE;
        FUNCTION TDebugApplication.HandleUpdateEvent(VAR theEventInfo: EventInfo): TCommand;
            OVERRIDE;
        PROCEDURE TDebugApplication.PollEvent(allowApplicationToSleep: BOOLEAN); OVERRIDE;
        PROCEDURE TDebugApplication.HandleEvent(VAR theEvent: EventRecord); OVERRIDE;
        FUNCTION TDebugApplication.HandleAlienEvent(VAR theEventInfo: EventInfo): TCommand; OVERRIDE
            ;
        PROCEDURE TDebugApplication.PostHandleEvent(VAR theEventInfo: EventInfo); OVERRIDE;
        FUNCTION TDebugApplication.HandleKeyDownEvent(VAR theEventInfo: EventInfo): TCommand;
            OVERRIDE;
        FUNCTION TDebugApplication.HandleSystemEvent(VAR theEventInfo: EventInfo): TCommand;
            OVERRIDE;
        END;
    {$EndC}

VAR
    {$Push} {$J+}
    pUDebugInitialized: BOOLEAN;
    pCanEnterDebugger:    BOOLEAN;
    pFileName:            Str255;                         { Name of file to intercept for IO }

    pDebugWindow:        TWindow;                        { the window object that contains the debug
                                                         window }
    {$Pop}

    pMadeNMRequest:     BOOLEAN;                        { Have a pending NM request }
    pNmReq:             NMRec;                            { For notifying user from bg }
    pDisciplineMethodCalls: BOOLEAN;
    pInterceptExceptionVectors: BOOLEAN;                { whether to intercept the 68xxx lo-memory
                                                         exception vectors }
    pCanEnterWriteLn:    BOOLEAN;                        { Flag to keep us from re-entering the
                                                         WriteLn support }
    pAddTextFocusRec:    FocusRec;                        { Place to stow focus behind MacApp's back }

    pSavedState:        SavedState;                     { place to record the state of the
                                                         application }
    {$IFC qDebug}
    pDebugApplication:    TDebugApplication;                { the debug event handler }
    {$EndC}
    pDebugView:         TTranscriptView;                { the window object that contains the debug
                                                         window }
    pVBLInfo:            VBLInfo;

    pTraceToggle, pTraceEnabled: BOOLEAN;
    pBreakCount:        INTEGER;                        { current number of breakpoints set }
    pBreakClass, pBreakProc: ARRAY [1..10] OF MAName;
    pStackSpace:        Longint;                        { current total stack space; set in %_BP }
    pProcStack:         Longint;                        { current stack space for just last
                                                         procedure to do a %_BP }
    pBreakStack:        Longint;
    pStepOverStackSize: Longint;                        { when stepping the stack to break on if
                                                         same or less }
    pBrProcStack:        Longint;
    pSysErrPatch:        TrapPatch;
    pReserve:            Handle;

    pOldexBusError, pOldexAddressError, pOldexIllegalInst, pOldexZeroDivide, pOldexCheck,
    pOldexOverflow, pOldexLineF: ProcPtr;

    pMoreMem:            Longint;                        {-1 if no more to see; 0 if more stack trace
                                                         possible, else more memory dump}
    pRecentPC:            ARRAY [0..kRecent] OF RecentPC; { PC ring buffer }
    pRecentIndex:        INTEGER;

    pQuietOutput:        BOOLEAN;                        { if TRUE then we should not send trace
                                                         output to debug window }

    pMasters:            INTEGER;                        { # available master pointers found by
                                                         latest %_BP or %_EP }

    pEnterProc:         Ptr;
    pInspectProc:        Ptr;
    pSymbolProc:        Ptr;

    pFlagsInUse:        INTEGER;                        { number of flags currently in use }
    pFlagTable:         ARRAY [1..kMaxFlags] OF DebugFEntry;
    pSymsInUse:         INTEGER;                        { number of symbol table entries in use }
    pSymTable:            ARRAY [1..kMaxSyms] OF DebugSEntry;

    pPermFlag:            BOOLEAN;

    pTP2PerfGlobals:    TP2PerfGlobals;                 { Pointer to performance globals record
                                                         Non-nil if tools are inited }

    fCaptureProc:        ProcPtr;                        { procedure for capturing output; set it
                                                         with DebugCapture }

    pFullyHiddenFromMacapp: BOOLEAN;                    { Are we stopped in the read loop }
    pWasAheadOfDebugWindow, pWasFrontWindow: WindowPtr;
    pWasActive:         BOOLEAN;
    pQHdr:                QHdr;                            { Saved Event Queue Header }
    pQSize:             INTEGER;                        { number of events }

    discardStr:         MAName;                         { a string that is used as a placeholder in
                                                         any calls where rqd but the result is not
                                                         rqd. Helps to reduce stack requirements }

    { the following were locals to MADebuggerMainEntry but… since the debugger is not re-entrant (for now) they can be
    globals and thus available to the procedures that were nested in MADebuggerMainEntry but are no longer.
    Also we knock off about 2k of stack requirements. }
    which:                ZT;
    pLink:                Longint;
    ppc:                Longint;
    aClassName:         MAName;
    aProcName:            MAName;
    aMiscName:            MAName;
    asDecimal, asHex:    Longint;
    pAtBreak:            BOOLEAN;
    callerFrame:        Longint;
    ch:                 CHAR;
    className:            MAName;
    itsFrame:            Longint;
    nextFrame:            Longint;
    nextLevel:            INTEGER;
    {$Ifc qPerform}
    oldState:            BOOLEAN;                        { State of Performance monitoring when
                                                         enterproc called and the state to which
                                                         monitering will return. Performance
                                                         monitering toggle changes this value }
    {$Endc}
    pNextPC:            Longint;
    prevFrame:            Longint;
    procName:            MAName;
    rcvrClass:            MAName;
    rcvrHandle:         HexAddress;
    receiver:            TObject;
    segNum:             INTEGER;
    stkBreak:            BOOLEAN;
    stepBreak:            BOOLEAN;
    str:                MAName;
    waiting:            BOOLEAN;

{--------------------------------------------------------------------------------------------------}
    {$Ifc qPerform}
    {$S MADebugger}

FUNCTION DebugPerfMonitor(turnOn: BOOLEAN): BOOLEAN;
{ Turns performance tracing on and off if installed. }

    BEGIN
    IF (pTP2PerfGlobals <> NIL) & pUDebugInitialized THEN
        DebugPerfMonitor := PerfControl(pTP2PerfGlobals, turnOn)
    ELSE
        DebugPerfMonitor := FALSE;
    END;
{$Endc}

{$IFC qDebug}
{--------------------------------------------------------------------------------------------------}

FUNCTION DevFAccess(fName: UNIV IEFilePathPtr;
                    opCode: Longint;
                    arg: UNIV Longint): Longint;
    C; EXTERNAL;

FUNCTION DevClose(fdesc: IEFRefNum): Longint;
    C; EXTERNAL;

FUNCTION DevRead(fdesc: IEFRefNum;
                 bufp: UNIV Longint;
                 count: Longint): Longint;
    C; EXTERNAL;

FUNCTION DevWrite(fdesc: IEFRefNum;
                  bufp: UNIV Longint;
                  count: Longint): Longint;
    C; EXTERNAL;

FUNCTION DevIoctl(fdesc: IEFRefNum;
                  request: Longint;
                  arg: UNIV Longint): Longint;
    C; EXTERNAL;

FUNCTION _addDevHandler(slot, dvName, dvFAccess, dvClose, dvRead, dvWrite,
                        dvIoctl: Longint): Longint;
    C; EXTERNAL;

{--------------------------------------------------------------------------------------------------}
{ The following are assembler routines in UDebug.a }

PROCEDURE XDebugSysError;
    EXTERNAL;
{ PROCEDURE XDebugNMI;    EXTERNAL; }

PROCEDURE XDebugBusError;
    EXTERNAL;

PROCEDURE XDebugAddrError;
    EXTERNAL;

PROCEDURE XDebugIllInst;
    EXTERNAL;

PROCEDURE XDebugZeroDiv;
    EXTERNAL;

PROCEDURE XDebugCheck;
    EXTERNAL;

PROCEDURE XDebugOverflow;
    EXTERNAL;

PROCEDURE XDebugLineF;
    EXTERNAL;

PROCEDURE VBLInstall;
    FORWARD;

PROCEDURE VBLRemove;
    FORWARD;

{--------------------------------------------------------------------------------------------------}

FUNCTION SetGetProc(theGetProc: ProcPtr): ProcPtr;
    EXTERNAL;

FUNCTION SetPutProc(thePutProc: ProcPtr): ProcPtr;
    EXTERNAL;

{--------------------------------------------------------------------------------------------------}

FUNCTION CallSymActionProc(actionProc: ProcPtr): Handle;
    INLINE $205F, $4E90;
{  MOVE.L  (A7)+,A0
JSR (A0)
}

FUNCTION CallSymbolLookup(VAR sym: Str255;
                          lookerUpper: Ptr): Longint;
    INLINE $205F, $4E90;
{  MOVE.L  (A7)+,A0
JSR (A0)
}

PROCEDURE CallInspector(obj: TObject;
                        inspector: Ptr);
    INLINE $205F, $4E90;
{  MOVE.L  (A7)+,A0
JSR (A0)
}

FUNCTION CallFlagActionProc(OnOrOff: BOOLEAN;
                            actionProc: ProcPtr): BOOLEAN;
    INLINE $205F, $4E90;
{ MOVE.L (A7)+,A0
JSR (A0)
}

PROCEDURE CallEnter(entering: BOOLEAN;
                    proc: Ptr);
    INLINE $205F, $4E90;
{  MOVE.L  (A7)+,A0
JSR (A0)
}

PROCEDURE CallCapture(textBuf: Ptr;
                      byteCount: INTEGER;
                      captureProc: ProcPtr);
    INLINE $205F, $4E90;
{ MOVEA.L (A7)+,A0
JSR (A0)
}

PROCEDURE MainHelpProc;
    FORWARD;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

PROCEDURE CurrentCursor(VAR C: Cursor);

    BEGIN
    BlockMove(Ptr(GetTheCrsr), Ptr(@C), sizeof(Cursor));
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

FUNCTION YouAreWarned: BOOLEAN;
{ Returns true if the super secret power keys are held down.
Used to indicate to the debugger that the programmer wants to flirt with _DANGER_!
If you do this then you're _ON_YOUR_OWN. }

    VAR
        aKeyMap:            KeyMap;
        oldState:            INTEGER;

    BEGIN
    oldState := IntegerPtr(JournalFlag)^;
    IntegerPtr(JournalFlag)^ := 0;                        { turn off journaling }
    GetKeys(aKeyMap);
    IntegerPtr(JournalFlag)^ := oldState;
    IF aKeyMap[$3B] THEN
        YouAreWarned := true
    ELSE
        YouAreWarned := FALSE;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

PROCEDURE TDebugApplication.IDebugApplication;

    VAR
        aCommandList:        TCommandList;

    BEGIN
    fTicksOfLastIdle := 0;
    fTicksTilNextIdle := 0;
    fCommandQueue := NIL;
    fLastCommand := NIL;

    IEvtHandler(NIL);

    New(aCommandList);
    FailNil(aCommandList);
    aCommandList.ICommandList;
    fCommandQueue := aCommandList;
    {$IFC qDebug}
    fCommandQueue.SetEltType('TCommand');
    {$ENDC}

    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

FUNCTION TDebugApplication.WMgrToWindow(aWMgrWindow: WindowPtr): TWindow;

    VAR
        theWindow:            TWindow;

    BEGIN
    theWindow := INHERITED WMgrToWindow(aWMgrWindow);
    { Make sure we only operate on debugger windows here }
    IF (theWindow <> pDebugWindow) & (NOT YouAreWarned) THEN
        theWindow := NIL;
    WMgrToWindow := theWindow;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

FUNCTION TDebugApplication.DoMenuCommand(aCmdNumber: CmdNumber): TCommand;

    BEGIN
    IF YouAreWarned THEN
        DoMenuCommand := INHERITED DoMenuCommand(aCmdNumber)
    ELSE
        BEGIN
        DoMenuCommand := NIL;
        CASE aCmdNumber OF
            cQuit:
                BEGIN
                { Be kind to those with TApplication.Close routines }
                IF pSavedState.gApplication <> NIL THEN
                    gApplication := pSavedState.gApplication;
                ExitToShell;
                END;
        END;
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

FUNCTION TDebugApplication.HandleUpdateEvent(VAR theEventInfo: EventInfo): TCommand;

    BEGIN
    IF pDebugWindow.HasPendingUpdate THEN
        BEGIN
        pDebugWindow.Update;
        HandleUpdateEvent := NIL;
        END
    ELSE
        HandleUpdateEvent := INHERITED HandleUpdateEvent(theEventInfo);
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

FUNCTION TDebugApplication.MenuEvent(menuItem: Longint): TCommand;

    VAR
        fi:                 FailInfo;
        cmd:                CmdNumber;
        deskAccName:        Str255;
        theMenuNumber:        INTEGER;
        theItemNumber:        INTEGER;
        savedPort:            GrafPtr;

    BEGIN
    MenuEvent := NIL;

    theMenuNumber := HiWrd(menuItem);
    theItemNumber := LoWrd(menuItem);

    IF theMenuNumber <> 0 THEN
        BEGIN

        cmd := CmdFromMenuItem(theMenuNumber, theItemNumber);

        IF (cmd < 0) & (theMenuNumber = mApple) THEN
            BEGIN
            GetItem(MAGetMenu(mApple), theItemNumber, deskAccName);
            GetPort(savedPort);
            IF OpenDeskAcc(deskAccName) = noErr THEN;    { MultiFinder be good to us! }
            SetPort(savedPort);
            END
        ELSE IF (cmd < cEditBase) | (cmd > cEditLast) | (NOT SystemEdit(cmd - cEditBase)) THEN
            BEGIN

            MenuEvent := gTarget.DoMenuCommand(cmd)

            END;
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

FUNCTION TDebugApplication.HandleMouseDown(VAR theEventInfo: EventInfo): TCommand;

    VAR
        doClick:            BOOLEAN;
        aWindow:            TWindow;
        aWMgrWindow:        WindowPtr;
        whereMouseDown:     INTEGER;
        sysWindowAct:        BOOLEAN;
        aCommand:            TCommand;
        theMouse:            Point;
        theVMouse:            VPoint;
        hysteresis:         Point;

    BEGIN
    HandleMouseDown := NIL;

    WITH theEventInfo, thePEvent^ DO
        BEGIN
        whereMouseDown := FindWindow(where, aWMgrWindow);
        aWindow := WMgrToWindow(aWMgrWindow);
        END;

    IF whereMouseDown <> inContent THEN
        SetCursor(arrow);

    WITH theEventInfo, thePEvent^ DO
        CASE whereMouseDown OF
            inMenuBar:
                BEGIN
                HandleMouseDown := MenuEvent(MenuSelect(where));
                END;

            inSysWindow:
                SystemClick(thePEvent^, aWMgrWindow);

            OTHERWISE
                    { if a MacApp window was associated with the WindowPtr then let the window object
                    decide what to do with the mouse click }
                IF (aWindow <> NIL) & aWindow.Focus THEN { if we can't focus, we're in trouble }
                    BEGIN
                    theMouse := where;
                    GlobalToLocal(theMouse);
                    aWindow.QDToViewPt(theMouse, theVMouse);
                    hysteresis := gStdHysteresis;        { don't want std changed by var }
                    IF aWindow.HandleMouseDown(theVMouse, theEventInfo, hysteresis, aCommand) &
                       (aCommand <> NIL) THEN
                        BEGIN
                        aCommand.fTracksMouse := true;    {??? someday this won't be forced }
                        aCommand.fInitialPt := where;    {??? someday this won't be forced }
                        HandleMouseDown := aCommand;
                        END;
                    END
                ELSE IF qDebug THEN
                    BEGIN
                    IF aWindow <> NIL THEN
                        ProgramBreak(
                              'In TApplication.HandleMouseDown: couldn''t focus on a window object!'
                                     )
                    ELSE IF gIntenseDebugging THEN
                        WriteLn('Got a mouse event for a non-MacApp, non-system window');
                    END;

        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

PROCEDURE SaveEventQueue(save: BOOLEAN);

    CONST
        kLMEvtBufCnt        = $154;

    BEGIN
    IF save THEN
        BEGIN
        { Save the existing event queue }
        pQHdr := GetEvQHdr^;
        WITH GetEvQHdr^ DO
            BEGIN
            qFlags := 0;
            qHead := NIL;
            qTail := NIL;
            END;
        pQSize := IntegerPtr(kLMEvtBufCnt)^;
        END
    ELSE
        BEGIN
        { Restore the event queue }
        FlushEvents(everyEvent, 0);
        GetEvQHdr^ := pQHdr;
        IntegerPtr(kLMEvtBufCnt)^ := pQSize;
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

FUNCTION DebugGetActiveWindow: TWindow;

    VAR
        oldFloats:            BOOLEAN;

    BEGIN
    oldFloats := pDebugWindow.fFloats;
    pDebugWindow.fFloats := FALSE;                        { so the debugger window doesn't get
                                                         reported }
    DebugGetActiveWindow := gApplication.GetActiveWindow;
    pDebugWindow.fFloats := FALSE;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

FUNCTION DebugGetActiveDocument: TDocument;

    BEGIN
    IF DebugGetActiveWindow <> NIL THEN
        DebugGetActiveDocument := DebugGetActiveWindow.fDocument
    ELSE
        DebugGetActiveDocument := NIL;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

FUNCTION DebugGetLastCommand: TCommand;

    BEGIN
    IF pSavedState.gTarget <> NIL THEN
        DebugGetLastCommand := pSavedState.gTarget.GetLastCommand
    ELSE
        DebugGetLastCommand := NIL;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

PROCEDURE ExchangeHandles(VAR handle1, handle2: UNIV Handle);

    VAR
        savedHandle:        Handle;

    BEGIN
    savedHandle := handle1;
    handle1 := handle2;
    handle2 := savedHandle;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

FUNCTION TDebugApplication.HandleKeyDownEvent(VAR theEventInfo: EventInfo): TCommand;

    VAR
        ch:                 CHAR;
        keycode:            INTEGER;

    BEGIN
    WITH theEventInfo, thePEvent^ DO
        BEGIN
        ch := CHR(BAND(message, charCodeMask));
        keycode := BSR(BAND(message, keyCodeMask), 8);

        IF theCmdKey & YouAreWarned THEN
            HandleKeyDownEvent := gTarget.DoCommandKey(ch, theEventInfo)
        ELSE
            HandleKeyDownEvent := gTarget.DoKeyCommand(ch, keycode, theEventInfo);
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

PROCEDURE RemoveAnyNMRequests;

    BEGIN
    IF pMadeNMRequest THEN
        BEGIN
        pMadeNMRequest := FALSE;
        IF gConfiguration.systemVersion >= $0600 THEN
            BEGIN
            {$IFC qMPW31}
            FailOSErr(NMRemove(QElemPtr(@pNmReq)));
            ReleaseResource(pNmReq.nmSIcon);
            {$ELSEC}
            FailOSErr(NMRemove(@pNmReq));
            ReleaseResource(pNmReq.nmIcon);
            {$ENDC}
            END;

        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

PROCEDURE InstallAnNMRequest;

    BEGIN
    IF NOT pMadeNMRequest THEN
        BEGIN
        pMadeNMRequest := true;
        IF gConfiguration.systemVersion >= $0600 THEN
            BEGIN
            WITH pNmReq DO
                BEGIN
                qType := nmType;
                nmMark := 1;                            { mark in Apple menu }
                {$IFC qMPW31}
                nmSIcon := GetResource('SICN', kDebugSICN); {handle to small icon}
                IF nmSIcon <> NIL THEN
                    HNoPurge(nmSIcon);
                {$ELSEC}
                nmIcon := GetResource('SICN', kDebugSICN); {handle to small icon}
                IF nmIcon <> NIL THEN
                    HNoPurge(nmIcon);
                {$ENDC}
                nmSound := Handle( - 1);                {handle to sound record}
                nmStr := NIL;                            {string to appear in alert}
                nmResp := NIL;                            {pointer to response routine}
                nmRefCon := 0;                            {for application use}
                END;
            {$IFC qMPW31}
            FailOSErr(NMInstall(QElemPtr(@pNmReq)));
            {$ELSEC}
            FailOSErr(NMInstall(@pNmReq));
            {$ENDC}
            END;

        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

FUNCTION TDebugApplication.HandleSystemEvent(VAR theEventInfo: EventInfo): TCommand;

    VAR
        switchingIn:        BOOLEAN;
        convertClipboard:    BOOLEAN;
        aWindow:            TWindow;

    BEGIN

    IF NOT YouAreWarned THEN
        BEGIN
        WITH theEventInfo.thePEvent^ DO
            CASE BSR(message, 24) OF
                kSuspendOrResume:
                    BEGIN
                    switchingIn := Odd(message);
                    IF pDebugWindow.fWMgrWindow = FrontWindow THEN
                        pDebugWindow.Activate(switchingIn);
                    gInBackground := NOT switchingIn;    { for MacApp }
                    RemoveAnyNMRequests;
                    END;
            END;
        END
    ELSE
        WITH theEventInfo.thePEvent^ DO
            CASE BSR(BAND(message, $FF000000), 24) OF
                kSuspendOrResume:
                    BEGIN
                    switchingIn := Odd(message);
                    convertClipboard := BAND(message, $00000002) <> 0;

                    IF switchingIn THEN
                        RegainControl(convertClipboard)
                    ELSE
                        AboutToLoseControl(convertClipboard);

                    IF switchingIn THEN
                        aWindow := GetFrontWindow
                    ELSE
                        aWindow := GetActiveWindow;

                    IF aWindow <> NIL THEN
                        aWindow.Activate(switchingIn);
                    gInBackground := NOT switchingIn;
                    RemoveAnyNMRequests;
                    END;
            END;

    HandleSystemEvent := NIL;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

FUNCTION TDebugApplication.HandleAlienEvent(VAR theEventInfo: EventInfo): TCommand;
{ In the debugger we don't send events down the co-handler chain. }

    BEGIN
    HandleAlienEvent := NIL;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

PROCEDURE TDebugApplication.HandleEvent(VAR theEvent: EventRecord);

    VAR
        fi:                 FailInfo;
        commandToPerform:    TCommand;
        theEventInfo:        EventInfo;

    BEGIN
    WITH theEventInfo, theEvent DO
        BEGIN
        thePEvent := @theEvent;
        theBtnState := BAND(modifiers, btnState) <> 0;
        theCmdKey := BAND(modifiers, cmdKey) <> 0;
        theShiftKey := BAND(modifiers, shiftKey) <> 0;
        theAlphaLock := BAND(modifiers, alphaLock) <> 0;
        theOptionKey := BAND(modifiers, optionKey) <> 0;
        theControlKey := BAND(modifiers, controlKey) <> 0;
        theAutoKey := what = autoKey;
        theClickCount := gClickCount;
        affectsMenus := true;                            { assume going in that this event affects
                                                         the menus }
        IF NOT YouAreWarned THEN
            affectsMenus := FALSE;                        { not in the debugger they don't }
        END;

    DispatchEvent(theEventInfo, commandToPerform);
    IF (commandToPerform = NIL) THEN
        commandToPerform := GetNextCommand;

    IF (commandToPerform <> NIL) & (commandToPerform <> NIL) THEN
        PerformCommand(commandToPerform);

    IF YouAreWarned THEN
        PostHandleEvent(theEventInfo);

    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

PROCEDURE TDebugApplication.PostHandleEvent(VAR theEventInfo: EventInfo);

    VAR
        sysWindowAct:        BOOLEAN;
        perm:                BOOLEAN;

    BEGIN
    IF MenuBarHasPendingUpdate THEN                     { application wants menu bar redrawn }
        SetupTheMenus                                    { …so draw it immediately. }
    ELSE IF theEventInfo.affectsMenus THEN
        InvalidateMenus;

    { See if a system window has been activated or deactivated. }
    sysWindowAct := IsDeskAccessory(FrontWindow);

    IF sysWindowAct <> gSysWindowActive THEN
        BEGIN
        gSysWindowActive := sysWindowAct;

        IF gSysWindowActive THEN                        { deactivating to sys window }
            BEGIN
            AboutToLoseControl(true);
            InvalidateMenuBar;
            END
        ELSE                                            { coming back from sys window }
            RegainControl(true);
        END;

    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

PROCEDURE TDebugApplication.PollEvent(allowApplicationToSleep: BOOLEAN);

    LABEL 1000;

    VAR
        ch:                 CHAR;
        theEvent:            EventRecord;
        theEventInfo:        EventInfo;
        r:                    Rect;
        aPartCode:            INTEGER;
        aWMgrWindow:        WindowPtr;

        savePort:            GrafPtr;
        savedScript:        INTEGER;

        switchingIn:        BOOLEAN;
        pt:                 Point;
        haveChar:            BOOLEAN;
        aEvQElPtr:            EvQElPtr;
        aMessage:            Longint;
        aCommand:            TCommand;
        keycode:            INTEGER;
        hasEvent:            BOOLEAN;
        commandToPerform:    TCommand;
        fi:                 FailInfo;

    PROCEDURE HdlPollEvt(error: INTEGER;
                         message: Longint);

        BEGIN
        {$IFC qDebug}
        WriteLn;                                        { add a blank line after all the messages
                                                         from Failure }
        {$ENDC}
        gEventLevel := gEventLevel - 1;
        BEGIN
        IF error <> noErr THEN
            BEGIN
            ShowError(error, message);
            END;
        HiliteMenu(0);                                    { Make sure menu isn't left highlighted. }
        GOTO 1000;                                        { Keep the application running. }
        END;
        END;

    BEGIN
    gEventLevel := gEventLevel + 1;
    CatchFailures(fi, HdlPollEvt);
    PLflush(output);                                    { guarantee that user can see prompts }

    { Blow off the focus }
    gFocusedView := NIL;

    IF NOT gInBackground THEN
        HiliteMenu(mDebug);

    IF NOT pDebugWindow.IsShown THEN
        BEGIN
        pDebugWindow.Open;
        pDebugView.RevealInsertionPoint;
        END;

    SetCursor(arrow);
    IF gTarget.DoIdle(idleBegin) THEN;

    IF qNeedsScriptManager | gConfiguration.hasScriptManager THEN
        savedScript := SetKeyScript(Font2Script(GrafPtr(pDebugWindow.fWMgrWindow)^.txFont));

    { IF we have any queued commands that have not otherwise been taken care of, now is the time. }

    commandToPerform := GetNextCommand;
    IF commandToPerform <> NIL THEN
        PerformCommand(commandToPerform);

    IF qNeedsWaitNextEvent | gConfiguration.hasWaitNextEvent THEN
        hasEvent := WaitNextEvent(everyEvent, theEvent, GetCaretTime, NIL)
    ELSE
        BEGIN
        SystemTask;
        hasEvent := GetNextEvent(everyEvent, theEvent)
        END;

    IF hasEvent THEN
        BEGIN
        { package it }
        HandleEvent(theEvent);

        END;

    Success(fi);
    gEventLevel := gEventLevel - 1;

1000:                                                    { Failure re-entry point }
    IF qNeedsScriptManager | gConfiguration.hasScriptManager THEN
        savedScript := SetKeyScript(savedScript);
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

PROCEDURE WithHideFromMacAppDo(PROCEDURE WhatToDo;
                               itsHideType: HideType);
{
Intended for doit behind macapp's back stuff.
Fullhide indicates whether to give enough support to fully stop in the debugger
}

    VAR
        oldPerm:            BOOLEAN;
        oldpCanEnterDebugger: BOOLEAN;

        oldpFullyHiddenFromMacapp: BOOLEAN;
        oldpDisciplineMethodCalls: BOOLEAN;
        oldDebugWindowNextHandler: TEvtHandler;
        fi:                 FailInfo;
        OldA5:                Longint;
        saveResLoad:        BOOLEAN;
        saveResFile:        INTEGER;


    PROCEDURE UnloadActivateEvents;
{ Activate events are manufactured by the window manager
Thus they need to be preserved. The activate event if any
is retrieved then the procedure recursed to get any more.  Then
the events are reposted on the application event queue. }

        VAR
            theEvent:            EventRecord;
            aEvQElPtr:            EvQElPtr;

        BEGIN
        IF GetNextEvent(activMask, theEvent) THEN
            BEGIN
            UnloadActivateEvents;                        { recurse to get more }
            WITH theEvent DO
                BEGIN
                IF (PPostEvent(activateEvt, message, aEvQElPtr)) = noErr THEN
                    aEvQElPtr^.evtQmodifiers := modifiers;
                END;
            END;
        END;

    PROCEDURE MiniHide;
        BEGIN
        OldA5 := SetCurrentA5;                                {}
        saveResLoad := GetResLoad;
        SetResLoad(TRUE);
        saveResFile := MAUseResFile(gApplicationRefNum);
        END;

    PROCEDURE MiniShow;
        BEGIN
        IF MAUseResFile(saveResFile) = 0 THEN ;
        SetResLoad(saveResLoad);
        OldA5 := SetA5(OldA5);
        END;

    PROCEDURE HideFromMacApp;

        BEGIN
        MiniHide; { Everyone has to do a MiniHide }
        oldpFullyHiddenFromMacapp := pFullyHiddenFromMacapp;
        IF NOT oldpFullyHiddenFromMacapp THEN
            Case itsHideType of
            RawHide:
                ; { Already done }

            PartialHide:
                BEGIN
                oldpCanEnterDebugger := pCanEnterDebugger;
                pSavedState.gIntenseDebugging := gIntenseDebugging;
                pSavedState.gDebugPrinting := gDebugPrinting;

                pCanEnterDebugger := FALSE;
                gDebugPrinting := FALSE;
                gIntenseDebugging := FALSE;

                oldPerm := PermAllocation(FALSE);
                oldpDisciplineMethodCalls := DisciplineMethodCalls(FALSE);

                GetFocus(pSavedState.pFocusRec);
                gPrinting := FALSE;
                gDrawingPictScrap := FALSE;
                gDrawingPictScrapView := NIL;

                pSavedState.gBusyTempRgn := gBusyTempRgn;
                pSavedState.gUsedBy := gUsedBy;

                gBusyTempRgn := FALSE;
                gUsedBy := '';
                ExchangeHandles(pSavedState.gTempRgn, gTempRgn);
                ExchangeHandles(pSavedState.SaveVisRgn, GetSaveVisRgnPtr^);

                END;

            FullHide:
                BEGIN
                pFullyHiddenFromMacapp := true;
                { make sure this is set to FALSE in case of new EXIT statements }
                pPermFlag := PermAllocation(FALSE);
                pDisciplineMethodCalls := DisciplineMethodCalls(FALSE);
                ShowCursor;
                pDebugView.fHelpProc := NIL;
                oldDebugWindowNextHandler := pDebugWindow.fNextHandler;
                pDebugWindow.fNextHandler := pDebugApplication;

                ExchangeHandles(pSavedState.SaveVisRgn, GetSaveVisRgnPtr^);

                pSavedState.gTarget := gTarget;
                pSavedState.gClickCount := gClickCount;
                pSavedState.gErrorParm3 := gErrorParm3;
                pSavedState.gEventLevel := gEventLevel;
                pSavedState.gIdlePhase := gIdlePhase;
                pSavedState.gInBackground := gInBackground;
                pSavedState.gLastClickPart := gLastClickPart;
                pSavedState.gLastDeskAcc := gLastDeskAcc;
                pSavedState.gLastMsePt := gLastMsePt;
                pSavedState.gLastUpTime := gLastUpTime;
                pSavedState.gMainEventMask := gMainEventMask;
                pSavedState.gApplication := gApplication;
                pSavedState.gIntenseDebugging := gIntenseDebugging;
                pSavedState.gDebugPrinting := gDebugPrinting;

                pSavedState.gBusyTempRgn := gBusyTempRgn;
                gBusyTempRgn := FALSE;
                pSavedState.gUsedBy := gUsedBy;
                gUsedBy := '';
                ExchangeHandles(pSavedState.gTempRgn, gTempRgn);
                ExchangeHandles(pSavedState.gCursorRgn, gCursorRgn);

                GetFocus(pSavedState.pFocusRec);

                 {### NO! pDebugApplication.InvalidateFocus; }

                gPrinting := FALSE;
                gDrawingPictScrap := FALSE;
                gDrawingPictScrapView := NIL;

                gApplication := pDebugApplication;
                gIntenseDebugging := FALSE;
                gDebugPrinting := FALSE;

                { Now blow the Focus }
                gFocusedView := NIL;

                gTarget := pDebugView;

                UnloadActivateEvents;
                SaveEventQueue(true);

                pWasAheadOfDebugWindow := FindWindowBefore(pDebugWindow.fWMgrWindow);
                IF FrontWindow <> pDebugWindow.fWMgrWindow THEN
                    pWasFrontWindow := FrontWindow
                ELSE
                    pWasFrontWindow := NIL;

                pWasActive := pDebugWindow.fIsActive;

                IF NOT pWasActive THEN
                    BEGIN
                    IF NOT pDebugWindow.IsShown THEN
                        pDebugWindow.Open;
                    IF true | NOT gInBackground THEN
                        BEGIN
                        HiliteWindow(pDebugWindow.fWMgrWindow, true);
                        IF pWasFrontWindow <> NIL THEN
                            HiliteWindow(pWasFrontWindow, FALSE);
                        pDebugWindow.Activate(true);
                        END;
                    pDebugView.RevealInsertionPoint;
                    END;    { NOT pWasActive }
                END;        { FullHide }
            END;            { CASE }
        END;                { HideFromMacApp }

    PROCEDURE ShowToMacApp;

        BEGIN
        IF NOT oldpFullyHiddenFromMacapp THEN
            Case itsHideType OF
            RawHide:
                ;    { Everyone has to do a miniShow (see below) }

            PartialHide:
                BEGIN
                ExchangeHandles(pSavedState.SaveVisRgn, GetSaveVisRgnPtr^);
                SetEmptyRgn(pSavedState.SaveVisRgn);    { make sure the region stays empty }
                ExchangeHandles(pSavedState.gTempRgn, gTempRgn);
                gBusyTempRgn := pSavedState.gBusyTempRgn;
                gUsedBy := pSavedState.gUsedBy;

                SetFocus(pSavedState.pFocusRec);

                IF DisciplineMethodCalls(oldpDisciplineMethodCalls) THEN;
                IF PermAllocation(oldPerm) THEN;

                gDebugPrinting := pSavedState.gDebugPrinting;
                gIntenseDebugging := pSavedState.gIntenseDebugging;
                pCanEnterDebugger := oldpCanEnterDebugger;
                END;

            FullHide:
                BEGIN
                pDebugView.fHelpProc := @MainHelpProc;
                pDebugWindow.fNextHandler := oldDebugWindowNextHandler;

                IF (NOT pWasActive) & (NOT gSingleStep) & (pStepOverStackSize = 0) THEN
                    BEGIN
                    IF pWasFrontWindow <> NIL THEN
                        HiliteWindow(pWasFrontWindow, true);
                    HiliteWindow(pDebugWindow.fWMgrWindow, FALSE);
                    pDebugWindow.Activate(FALSE);
                    END
                ELSE
                    pDebugWindow.fIsActive := pWasActive;

                IF pWasAheadOfDebugWindow <> NIL THEN
                    BEGIN
                    SendBehind(pDebugWindow.fWMgrWindow, pWasAheadOfDebugWindow);
                    pDebugWindow.Update;
                    END;

                SaveEventQueue(FALSE);

                SetFocus(pSavedState.pFocusRec);

                gBusyTempRgn := pSavedState.gBusyTempRgn;
                gUsedBy := pSavedState.gUsedBy;
                ExchangeHandles(pSavedState.gTempRgn, gTempRgn);

                gDebugPrinting := pSavedState.gDebugPrinting;
                gIntenseDebugging := pSavedState.gIntenseDebugging;
                gApplication := pSavedState.gApplication;
                gTarget := pSavedState.gTarget;
                gClickCount := pSavedState.gClickCount;
                gErrorParm3 := pSavedState.gErrorParm3;
                gEventLevel := pSavedState.gEventLevel;
                gIdlePhase := pSavedState.gIdlePhase;
                gInBackground := pSavedState.gInBackground;
                gLastClickPart := pSavedState.gLastClickPart;
                gLastDeskAcc := pSavedState.gLastDeskAcc;
                gLastMsePt := pSavedState.gLastMsePt;
                gLastUpTime := pSavedState.gLastUpTime;
                gMainEventMask := pSavedState.gMainEventMask;

                ExchangeHandles(pSavedState.gCursorRgn, gCursorRgn);
                ExchangeHandles(pSavedState.SaveVisRgn, GetSaveVisRgnPtr^);

                IF DisciplineMethodCalls(pDisciplineMethodCalls) THEN;
                pPermFlag := PermAllocation(pPermFlag);
                pFullyHiddenFromMacapp := FALSE;
                END;
            END;
        MiniShow;
        END;

    PROCEDURE HdlFailure(error: INTEGER;
                         message: Longint);

        BEGIN
        ShowToMacApp;
        pDebugView.EndForce;
        CallEnter(FALSE, pEnterProc);
        pCanEnterDebugger := true;

        END;

    BEGIN
    HideFromMacApp;
    if itsHideType <> RawHide THEN    { Stuff that's mini hidden isn't allowed to fail }
        CatchFailures(fi, HdlFailure);

    WhatToDo;

    if itsHideType <> RawHide THEN
        Success(fi);
    ShowToMacApp;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

FUNCTION DebugReadCh: CHAR;

    VAR
        oldHelpProc:        ProcPtr;

    BEGIN
    oldHelpProc := pDebugView.fHelpProc;
    pDebugView.fHelpProc := NIL;
    REPEAT
        pDebugApplication.PollEvent(kAllowApplicationToSleep);
    UNTIL pDebugView.fLastCh <> CHR(0);
    DebugReadCh := pDebugView.fLastCh;
    pDebugView.fLastCh := CHR(0);
    pDebugView.fHelpProc := oldHelpProc;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

FUNCTION DebugReadLn(buffer: Ptr;
                     byteCount: INTEGER): Longint;

    TYPE
        PA1000                = PACKED ARRAY [0..999] OF CHAR;
        StrPtr                = ^PA1000;

    VAR
        ch:                 CHAR;
        len:                INTEGER;

    PROCEDURE WhatToDo;

        BEGIN
        len := 0;

        REPEAT
            pDebugView.RevealInsertionPoint;
            ch := DebugReadCh;

            CASE ch OF
                chBackspace:
                    IF len > 0 THEN
                        BEGIN
                        Write(ch);
                        len := len - 1;
                        StrPtr(buffer)^[len] := ' ';
                        END;
                OTHERWISE
                    BEGIN
                    Write(ch);
                    StrPtr(buffer)^[len] := ch;
                    len := len + 1;
                    END
            END;
        UNTIL (ch = chReturn) | (len = byteCount);

        DebugReadLn := len;
        END;

    BEGIN
    IF FALSE & NOT pFullyHiddenFromMacapp THEN
        BEGIN
        which := tReadLn;
        IF gInBackground THEN
            InstallAnNMRequest;
        END;
    WithHideFromMacAppDo(WhatToDo, FullHide);
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

PROCEDURE InstallInterceptors(install: BOOLEAN);

    BEGIN

    IF install THEN
        BEGIN
        { Intercept 68000 exceptions }
        IF pInterceptExceptionVectors THEN
            BEGIN
            pOldexBusError := ProcPtrPtr(exBusError)^;
            ProcPtrPtr(exBusError)^ := @XDebugBusError;

            pOldexAddressError := ProcPtrPtr(exAddressError)^;
            ProcPtrPtr(exAddressError)^ := @XDebugAddrError;

            pOldexIllegalInst := ProcPtrPtr(exIllegalInst)^;
            ProcPtrPtr(exIllegalInst)^ := @XDebugIllInst;

            pOldexZeroDivide := ProcPtrPtr(exZeroDivide)^;
            ProcPtrPtr(exZeroDivide)^ := @XDebugZeroDiv;

            pOldexCheck := ProcPtrPtr(exCheck)^;
            ProcPtrPtr(exCheck)^ := @XDebugCheck;

            pOldexOverflow := ProcPtrPtr(exOverflow)^;
            ProcPtrPtr(exOverflow)^ := @XDebugOverflow;

            pOldexLineF := ProcPtrPtr(exLineF)^;
            ProcPtrPtr(exLineF)^ := @XDebugLineF;
            END;

        { Intercept SysError calls }
        FailOSErr(PatchTrap(pSysErrPatch, _SysError, @XDebugSysError));
        END
    ELSE
        BEGIN
        { UN-Intercept 68000 exceptions }
        IF pInterceptExceptionVectors THEN
            BEGIN
            IF ProcPtrPtr(exBusError)^ = @XDebugBusError THEN
                ProcPtrPtr(exBusError)^ := pOldexBusError;

            IF ProcPtrPtr(exAddressError)^ = @XDebugAddrError THEN
                ProcPtrPtr(exAddressError)^ := pOldexAddressError;

            IF ProcPtrPtr(exIllegalInst)^ = @XDebugIllInst THEN
                ProcPtrPtr(exIllegalInst)^ := pOldexIllegalInst;

            IF ProcPtrPtr(exZeroDivide)^ = @XDebugZeroDiv THEN
                ProcPtrPtr(exZeroDivide)^ := pOldexZeroDivide;

            IF ProcPtrPtr(exCheck)^ = @XDebugCheck THEN
                ProcPtrPtr(exCheck)^ := pOldexCheck;

            IF ProcPtrPtr(exOverflow)^ = @XDebugOverflow THEN
                ProcPtrPtr(exOverflow)^ := pOldexOverflow;

            IF ProcPtrPtr(exLineF)^ = @XDebugLineF THEN
                ProcPtrPtr(exLineF)^ := pOldexLineF;
            END;

        { UN-Intercept SysError calls }
        UnpatchTrap(pSysErrPatch);
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

PROCEDURE JTOffProc(A5JTOffset: UNIV INTEGER;
                    VAR s: UNIV DisAsmStr80);

    CONST
        kUnloaded            = $3F3C;

    VAR
        aName:                MAName;
        pc:                 Longint;

    BEGIN
    pc := Longint(GetA5) + A5JTOffset;
    IF IntegerPtr(pc)^ <> kUnloaded THEN
        BEGIN
        GetMethodName(ord(@pc), aName);
        s := aName;
        END
    ELSE
        s := '';
    END;

{$EndC}

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

FUNCTION IsUserBreak: BOOLEAN;

    VAR
        aKeyMap:            KeyMap;
        oldState:            INTEGER;

    BEGIN
    oldState := IntegerPtr(JournalFlag)^;
    IntegerPtr(JournalFlag)^ := 0;                        { turn off journaling }
    GetKeys(aKeyMap);
    IntegerPtr(JournalFlag)^ := oldState;
    IsUserBreak := aKeyMap[55] & aKeyMap[56] & aKeyMap[58] & (NOT qDebug | pUDebugInitialized);
    END;

{$IFC qDebug}
{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

PROCEDURE stdHelpProc;

    BEGIN
    WriteLn;
    WriteLn('Reply with one of the letters in the brackets');
    WriteLn;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

FUNCTION GetPromptedChar(prompt: StringPtr;
                         validChars: StringPtr;
                         PROCEDURE helpProc): CHAR;

    VAR
        ch:                 CHAR;
        done:                BOOLEAN;
        index:                INTEGER;

    PROCEDURE WriteThePrompt;

        BEGIN
        Write(prompt^); Write(' ['); Write(validChars^); Write(kHelpRequest);
        Write(']: ');
        END;

    BEGIN
    WriteThePrompt;
    REPEAT
        pDebugView.RevealInsertionPoint;
        ch := UprChar(DebugReadCh);
        CASE ch OF
            kHelpRequest, chHelp:
                BEGIN
                helpProc;
                WriteThePrompt;
                done := FALSE
                END;
            chReturn:
                BEGIN
                WriteLn;
                done := true;
                END;
            OTHERWISE
                BEGIN
                FOR index := 1 TO length(validChars^) DO
                    IF ch = UprChar(validChars^[index]) THEN
                        BEGIN
                        WriteLn(ch);
                        done := true;
                        LEAVE;
                        END;
                IF index > length(validChars^) THEN
                    gApplication.Beep(30);                { 1/2 second }
                END;
        END;
    UNTIL done;
    GetPromptedChar := ch;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

FUNCTION GetPromptedString(prompt: StringPtr;
                           PROCEDURE helpProc): Str255;

    VAR
        returnStr:            Str255;
        done:                BOOLEAN;

    BEGIN
    Write(prompt^);
    returnStr := '';
    REPEAT
        pDebugView.RevealInsertionPoint;
        ch := DebugReadCh;
        CASE ch OF
            chHelp:
                BEGIN
                WriteLn;
                helpProc;
                Write(prompt^);
                done := FALSE
                END;
            chBackspace:
                BEGIN
                IF length(returnStr) > 0 THEN
                    BEGIN
                    Write(ch);
                    returnStr[0] := CHR(max(length(returnStr) - 1, 0));
                    END;
                done := FALSE
                END;
            chReturn:
                BEGIN
                Write(ch);
                IF returnStr = kHelpRequest THEN
                    BEGIN
                    returnStr := '';
                    helpProc;
                    Write(prompt^);
                    done := FALSE
                    END
                ELSE
                    done := true;
                END;
            OTHERWISE
                BEGIN
                Write(ch);
                returnStr := concat(returnStr, ch);
                done := FALSE;
                END;
        END;
    UNTIL done;
    GetPromptedString := returnStr;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

FUNCTION GetFreeMastersCount: Longint;

    VAR
        zone:                THZ;
        pL:                 LongIntPtr;
        mpCnt:                Longint;

    BEGIN
    zone := ApplicZone;
    pL := LongIntPtr(zone^.hFstFree);
    mpCnt := 0;
    WHILE pL <> NIL DO
        BEGIN
        mpCnt := mpCnt + 1;
        pL := LongIntPtr(pL^);
        END;
    GetFreeMastersCount := mpCnt;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

PROCEDURE CheckFreeMasters;

    VAR
        mp:                 Longint;

    BEGIN
    IF pMasters > 0 THEN                                { we computed # masters before }
        BEGIN
        mp := GetFreeMastersCount;
        IF pMasters <> mp THEN
            BEGIN
            WriteLn('pMasters: ', pMasters, '  current masters: ', mp);
            IF gMemMgtBreak THEN
                gSingleStep := true;
            END;
        END;

    pMasters := GetFreeMastersCount
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

VAR
    aStaticString:        Str255;

PROCEDURE DebugWriteLn(textBuf: Ptr;
                       byteCount: INTEGER);

    VAR
        oldpCanEnterWriteLn: BOOLEAN;

    PROCEDURE WhatToDo;

        BEGIN
        IF fCaptureProc <> NIL THEN
            CallCapture(textBuf, byteCount, fCaptureProc);

        IF pDebugView <> NIL THEN
            pDebugView.AddText(textBuf, byteCount)        { send it to the current transcript window }
        END;

    BEGIN
    oldpCanEnterWriteLn := pCanEnterWriteLn;
    pCanEnterWriteLn := FALSE;

    IF NOT oldpCanEnterWriteLn THEN                     { Not re-entrant but at least give user a
                                                         fighting chance }
        BEGIN
        aStaticString[0] := CHR(Min(255, byteCount));
        BlockMove(textBuf, @aStaticString[1], length(aStaticString));
        DebugStr(concat('Re-entering DebugWriteLn: ', aStaticString));
        END;

    WithHideFromMacAppDo(WhatToDo, PartialHide);
      pCanEnterWriteLn := oldpCanEnterWriteLn;

    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

PROCEDURE InstallWriteLnHook;

    CONST
        kConsoleName        = 'Dev:Console';
        _CODEV                = 1;                        { console device number }

    VAR
        slot:                Longint;
        oldProc:            ProcPtr;

    BEGIN
    pFileName := kConsoleName;
    slot := _addDevHandler(_CODEV, 0, ord(@DevFAccess), ord(@DevClose), ord(@DevRead),
                           ord(@DevWrite), ord(@DevIoctl));
    PLsetvbuf(output, NIL, _IOLBF, 128);
    oldProc := SetGetProc(@DebugReadLn);
    oldProc := SetPutProc(@DebugWriteLn);
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAInit}

PROCEDURE InitUDebug(segTable, nonRes: Handle;
                     enterProc, inspectProc, symbolProc: Ptr);
{ essential initialization (segTable, nonRes left in for compatibility (2.0) }

    CONST
        kDebugHeight        = 100;
        kVMargin            = 4;
        kHMargin            = 4;

    TYPE
        dbugParams            = RECORD                    { Format of 'dbug' resource }
            boundsRect:         Rect;                    { Rect of debugging window }
            fontNumber:         INTEGER;                { Font rsrc ID }
            fontSize:            INTEGER;                { Font size }
            numLines:            INTEGER;                { Number of lines }
            lineWidth:            INTEGER;                { Line width }
            openInitially:        BOOLEAN;                { Open Initially }
            title:                Str255;                 { Actually, variable length }
            END;
        dbugParamsPtr        = ^dbugParams;
        dbugParamsHandle    = ^dbugParamsPtr;

    VAR
        aTranscriptView:    TTranscriptView;
        wasAddNewObjectsToInspector: BOOLEAN;
        wasTrcEnable:        BOOLEAN;
        dParams:            Handle;

        addr:                Longint;
        i:                    INTEGER;
        err:                OSErr;
        vhs:                VHSelect;
        zoomedOutSize:        Point;
        aDebugParams:        dbugParams;
        aTextStyle:         TextStyle;
        Errs:                Handle;

    BEGIN
    pCanEnterWriteLn := true;
    pMadeNMRequest := FALSE;
    IF YouAreWarned THEN                                { for testing }
        pInterceptExceptionVectors := FALSE
    ELSE
        pInterceptExceptionVectors := true;

    {$IFC NOT qDebugTheDebugger}
    wasAddNewObjectsToInspector := AddNewObjectsToInspector(FALSE);
    {$ENDC}

    New(pDebugApplication);

    {$IFC NOT qDebugTheDebugger}
    IF AddNewObjectsToInspector(wasAddNewObjectsToInspector) THEN;
    {$ENDC}

    FailNil(pDebugApplication);
    pDebugApplication.IDebugApplication;

    { T R I C K   N O T E }
    { This will allow debugger window operations (resizing, etc.) that require a gApplication
    to succeed before the real application is available.  When the real application's IApplication
    method is called the global: gApplication will be replaced with a reference to it. }
    gApplication := pDebugApplication;
    gTarget := pDebugApplication;

    pSavedState.SaveVisRgn := NIL;
    pSavedState.SaveVisRgn := MakeNewRgn;
    FailNil(pSavedState.SaveVisRgn);

    pSavedState.gCursorRgn := NIL;
    pSavedState.gCursorRgn := MakeNewRgn;
    FailNil(pSavedState.gCursorRgn);

    pTP2PerfGlobals := NIL;

    pTraceToggle := FALSE;
    gSingleStep := FALSE;
    pBreakCount := 0;
    pTraceEnabled := FALSE;
    gTracing := FALSE;
    gReportNext := FALSE;
    gReportInfo := '';
    gReportTime := FALSE;
    pQuietOutput := FALSE;

    pMasters := - 1;

    pFlagsInUse := 0;
    pSymsInUse := 0;

    gMaxStackDepth := - 1;
    pBreakStack := $7FFFFFFF;
    pStepOverStackSize := 0;
    pBrProcStack := $7FFFFFFF;
    gMaxLockedRsrc := 0;

    pAddTextFocusRec.Clip := NIL;
    pAddTextFocusRec.Clip := MakeNewRgn;
    pAddTextFocusRec.FocusedView := NIL;
    pAddTextFocusRec.Org := gZeroPt;
    pAddTextFocusRec.LongOffset := gZeroVPt;
    pAddTextFocusRec.Port := gWorkPort;
    pAddTextFocusRec.printing := FALSE;
    pAddTextFocusRec.drawingPictScrap := FALSE;

    pSavedState.pFocusRec.Clip := NIL;
    pSavedState.pFocusRec.Clip := MakeNewRgn;

    pSavedState.gBusyTempRgn := FALSE;
    pSavedState.gUsedBy := '';
    pSavedState.gTempRgn := NIL;
    pSavedState.gTempRgn := MakeNewRgn;
    pDisciplineMethodCalls := true;                     { matches default in uobject }

    pFullyHiddenFromMacapp := FALSE;

    pEnterProc := enterProc;
    pInspectProc := inspectProc;
    pSymbolProc := symbolProc;

    FOR i := 0 TO kRecent DO
        BEGIN
        pRecentPC[i].thePC := 0;
        pRecentPC[i].theZT := tSysError;
        END;
    pRecentIndex := 0;

    fCaptureProc := NIL;
    pReserve := NewPermHandle(kReserve);                { Reserve some space in case of SysErr }
    FailNil(pReserve);

    InstallInterceptors(true);

    {$IFC NOT qDebugTheDebugger}
    wasAddNewObjectsToInspector := AddNewObjectsToInspector(FALSE);
    {$ENDC}

    dParams := GetResource('dbug', kDebugParamsID);
    IF dParams <> NIL THEN
        BEGIN
        aDebugParams := dbugParamsHandle(dParams)^^;
        ReleaseResource(dParams);                        { asta la vista }
        WITH aDebugParams DO
            BEGIN
            IF EqualRect(boundsRect, gZeroRect) THEN
                BEGIN
                boundsRect := screenbits.bounds;
                InsetRect(boundsRect, 5, 5);
                boundsRect.top := boundsRect.bottom - kDebugHeight;
                END
            END
        END
    ELSE
        WITH aDebugParams DO
            BEGIN
            boundsRect := screenbits.bounds;
            InsetRect(boundsRect, 5, 5);
            boundsRect.top := boundsRect.bottom - kDebugHeight;

            fontNumber := kDebugFont;
            fontSize := kDebugSize;
            numLines := 120;
            lineWidth := 100;
            openInitially := FALSE;
            title := '';
            END;

    IF qTemplateViews THEN
        BEGIN
        pDebugWindow := NewTemplateWindow(kDebugWindowType, NIL);
        pDebugView := TTranscriptView(pDebugWindow.FindSubView('trns'));
        END
    ELSE
        BEGIN
        New(aTranscriptView);
        FailNil(aTranscriptView);
        WITH aDebugParams DO
            aTranscriptView.ITranscriptView(NIL, fontNumber, fontSize, numLines, lineWidth);

        pDebugView := aTranscriptView;

        pDebugWindow := NewSimpleWindow(kDebugWindowType, kWantHScrollBar, kWantVScrollBar, NIL,
                                        pDebugView);

        END;

    pDebugView.fHelpProc := @MainHelpProc;
    WITH aDebugParams DO
        BEGIN
        IF title <> '' THEN
            pDebugWindow.SetTitle(title);
        pDebugWindow.Locate(boundsRect.left, boundsRect.top, kDontInvalidate);
        pDebugWindow.Resize(MinMax(kSBarSize * 4, boundsRect.right - boundsRect.left,
                                   max(pDebugView.fSize.h + kSBarSize, boundsRect.right -
                                   boundsRect.left)), MinMax(kSBarSize * 4, boundsRect.bottom -
                                                             boundsRect.top,
                                                             max(pDebugView.fSize.v + kSBarSize,
                                                             boundsRect.bottom - boundsRect.top)),
                            kDontInvalidate);
        SetTextStyle(aTextStyle, fontNumber, [], fontSize, gRGBBlack);
        pDebugView.InstallTextStyle(aTextStyle);
        {$Push} {$H-}
        zoomedOutSize := VPtToPt(pDebugView.fSize);
        {$Pop}
        WITH zoomedOutSize DO
            BEGIN
            v := (2 * kVMargin) + (pDebugView.fFontHeight * (pDebugView.fRows));
            v := max(kSBarSize * 4, v + kSBarSize);
            h := max(kSBarSize * 4, h + kSBarSize);
            END;

        pDebugWindow.SetResizeLimits(gStdWSizeRect.topLeft, zoomedOutSize);
        pDebugWindow.ForceOnScreen;
        IF openInitially THEN
            pDebugWindow.Open;
        pDebugWindow.Update;
        END;

    gApplication.DeleteFreeWindow(pDebugWindow);        { so we don't show }

    {$IFC NOT qDebugTheDebugger}
    IF AddNewObjectsToInspector(wasAddNewObjectsToInspector) THEN;
    {$ENDC}

    {$IFC IncludeDisassembler}
    { Init Ira's disassembler }
    InitLookup(NIL, @JTOffProc, @LookupTrapName, NIL, NIL);
    {$EndC}

    VBLInstall;

    DebugGlobalHandle(@pSavedState.gTarget, NIL, AtMAName('gTarget'));
    DebugGlobalHandle(@pSavedState.gApplication, NIL, AtMAName('gApplication'));
    DebugGlobalHandle(@gDocList, NIL, AtMAName('gDocList'));
    DebugGlobalHandle(@gFreeWindowList, NIL, AtMAName('gFreeWindowList'));
    DebugGlobalHandle(@gClipView, NIL, AtMAName('gClipView'));
    DebugGlobalHandle(@gClipUndoView, NIL, AtMAName('gClipUndoView'));
    DebugGlobalHandle(@gPrintHandler, NIL, AtMAName('gPrintHandler'));
    DebugGlobalHandle(@pSavedState.pFocusRec.FocusedView, NIL, AtMAName('gFocusedView'));

    DebugGlobalHandle(NIL, @DebugGetLastCommand, AtMAName('GetLastCommand'));
    DebugGlobalHandle(NIL, @DebugGetActiveWindow, AtMAName('GetActiveWindow'));
    DebugGlobalHandle(NIL, @DebugGetActiveDocument, AtMAName('GetActiveDocument'));

    DebugFlag(@pSavedState.gIntenseDebugging, 'I', NIL, AtStr('Intense debugging'));
    DebugFlag(@gMemMgtBreak, 'B', NIL, AtStr('Memory management break'));
    DebugFlag(@gMastReport, 'M', NIL, AtStr('Report # masters'));
    DebugFlag(@gSegReport, 'S', NIL, AtStr('Report segment load'));
    DebugFlag(@gUnloadAllSegs, 'U', NIL, AtStr('Unload segments'));
    DebugFlag(@gExperimenting, 'X', NIL, AtStr('Experimenting'));
    DebugFlag(@gAskFailure, 'F', NIL, AtStr('Ask about failures'));
    DebugFlag(@gReportEvt, 'E', NIL, AtStr('Report events'));
    DebugFlag(@gAskAboutAlloc, 'A', NIL, AtStr('Ask about allocations'));
    DebugFlag(@gRsrcReport, 'R', NIL, AtStr('Report resource usage'));
    DebugFlag(@gReportMenuChoices, 'C', NIL, AtStr('Report menu commands'));
    DebugFlag(@pSavedState.gDebugPrinting, 'P', NIL, AtStr('Printing debug'));
    DebugFlag(@pDisciplineMethodCalls, 'D', @DisciplineMethodCalls,
              AtStr('Discipline method calls'));
    DebugFlag(@gAssumeFocused, 'V', NIL, AtStr('Do "AssumeFocused" preconditioning'));

    {$IFC qExperimentalAndUnsupported}
    DebugFlag(@gEnableDoubleBuffering, 'G', NIL, AtStr('Enable double buffering of views'));
    {$EndC}

    { Make sure the error strings are always available by loading them and but not
    letting them be purgeable }
    Errs := GetResource('STR#', 252);
    FailNILResource(Errs);
    HNoPurge(Errs);

    IF qTemplateViews THEN
        BEGIN
        { Suppress Linker dead stripping of these }
        IF gDeadStripSuppression THEN
            IF Member(TObject(NIL), TTranscriptView) THEN;
        END;

    { LAST THING ON INIT: install the console interceptor }
    InstallWriteLnHook;

    pUDebugInitialized := true;
    pCanEnterDebugger := true;

    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

PROCEDURE DebugTerminate;

    BEGIN
    IF pUDebugInitialized THEN
        BEGIN
        VBLRemove;

        IF DebugRedirect(0, NIL) <> noErr THEN;         { (discard result) close redirect file }

        {$IFC qPerform}
        { Make sure the performance tools are shut down if they are initialized }
        IF pTP2PerfGlobals <> NIL THEN
            BEGIN
            TermPerf(pTP2PerfGlobals);
            pTP2PerfGlobals := NIL;
            END;
        {$ENDC}

        InstallInterceptors(FALSE);

        { Guarantee we can't be re-entered }
        pUDebugInitialized := FALSE;
        pCanEnterDebugger := FALSE;

        END;
    END;
{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

PROCEDURE DebugFlag(flagAddr: BooleanPtr;
                    flagChar: CHAR;
                    theActionProc: ProcPtr;             {CONST}
                    flagDesc: StringPtr);
{ Register a BOOLEAN flag for the X debugger command;
flagAddr should be the address of the flag;
theActionProc should be a procPtr for a proc to be called to change the flag (optional).
flagChar should be the character to use in the debugger to toggle the flag;
desc should be a short description of the flag.
No checking is done for duplicate flagChars. }

    BEGIN
    IF pFlagsInUse < kMaxFlags THEN
        BEGIN
        pFlagsInUse := pFlagsInUse + 1;
        WITH pFlagTable[pFlagsInUse] DO
            BEGIN
            addr := flagAddr;
            ch := UprChar(flagChar);
            actionProc := theActionProc;
            desc := NewString(flagDesc^);
            FailNil(desc);
            END;
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

PROCEDURE DebugGlobalHandle(globAddr: Ptr;
                            theActionProc: ProcPtr;     {CONST}
                            globSym: MANamePtr);
{ Register a symbol name of a global variable that contains a handle;
Case does not matter.  The global variable should contain a Handle.
The Action proc is a Function to be called to derive the handle if necessary. }

    BEGIN
    IF pSymsInUse < kMaxSyms THEN
        BEGIN
        pSymsInUse := pSymsInUse + 1;
        WITH pSymTable[pSymsInUse] DO
            BEGIN
            addr := globAddr;
            actionProc := theActionProc;
            sym := globSym^;

            END;
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

FUNCTION GetPromptedNames(prompt: StringPtr;
                          VAR className, procName: MAName): BOOLEAN;

    VAR
        ch:                 CHAR;
        len:                INTEGER;
        s:                    Str255;
        i:                    INTEGER;

    PROCEDURE helpProc;

        BEGIN
        WriteLn;
        WriteLn('Please supply a ClassName.MethodName or MethodName or ProcName');
        WriteLn;
        END;

    BEGIN
    GetPromptedNames := FALSE;

    className := '';
    procName := '';
    len := 0;

    s := GetPromptedString(prompt, helpProc);

    FOR i := 1 TO length(s) DO
        BEGIN
        ch := UprChar(s[i]);

        IF ch IN ['A'..'Z', '0'..'9', '_', '%'] THEN
            BEGIN
            GetPromptedNames := true;
            len := len + 1;
            procName[len] := ch;
            procName[0] := CHR(len);
            END
        ELSE IF ch = '.' THEN
            BEGIN
            className := procName;
            procName := '';
            len := 0;
            END
        ELSE IF ch <> ' ' THEN
            BEGIN
            GetPromptedNames := FALSE;
            WriteLn(kDontKnow);
            Exit(GetPromptedNames);
            END;
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

FUNCTION GetPromptedValue(prompt: StringPtr;
                          VAR asDecimal, asHex: Longint;
                          symbolOK: BOOLEAN;
                          VAR gotSymbol: BOOLEAN): BOOLEAN;
 { returns TRUE iff a valid number is typed;
  if it returns FALSE but the parameters are 0, then the user typed only a return;

  if symbolOK is TRUE then a symbol is allowed, and gotSymbol will indicate if
  a symbol was typed }

    VAR
        ch:                 CHAR;
        digit:                INTEGER;
        anEvent:            EventRecord;
        s:                    Str255;
        i:                    INTEGER;
        sym:                Str255;
        done:                BOOLEAN;
        symbolTableSym:     Str255;
        gotNegation:        BOOLEAN;

    PROCEDURE helpProc;

        VAR
            i:                    INTEGER;

        BEGIN
        WriteLn;
        Write('Please supply a valid number');
        IF NOT symbolOK THEN
            WriteLn('.')
        ELSE
            BEGIN
            Write(' or one of the following symbols:');
            sym := kHelpRequest;
            asDecimal := CallSymbolLookup(sym, pSymbolProc);
            WriteLn;

            FOR i := 1 TO pSymsInUse DO
                Write(pSymTable[i].sym, ' ');
            WriteLn;
            END;
        END;

    BEGIN
    asDecimal := 0;
    asHex := 0;
    gotSymbol := FALSE;

    s := GetPromptedString(prompt, helpProc);
    UprString(s, FALSE);

    IF s = '' THEN
        GetPromptedValue := FALSE
    ELSE
        BEGIN
        GetPromptedValue := true;

        IF symbolOK & ((s[1] = '''') | NOT (s[1] IN ['-', '0'..'9', 'A'..'F'])) THEN
            BEGIN
            gotSymbol := true;

            IF s[1] = '''' THEN
                Delete(s, 1, 1);

            sym := s;

            asDecimal := CallSymbolLookup(sym, pSymbolProc);

            IF asDecimal = - 1 THEN                     { search local symbol table }
                BEGIN
                i := 1;
                symbolTableSym := pSymTable[i].sym;
                UprStr255(symbolTableSym);
                WHILE (i <= pSymsInUse) & (symbolTableSym <> sym) DO
                    BEGIN
                    i := i + 1;
                    IF (i <= pSymsInUse) THEN
                        BEGIN
                        symbolTableSym := pSymTable[i].sym;
                        UprStr255(symbolTableSym);
                        END;
                    END;

                IF i <= pSymsInUse THEN
                    BEGIN
                    IF pSymTable[i].addr = NIL THEN
                        asDecimal := Longint(CallSymActionProc(pSymTable[i].actionProc))
                    ELSE
                        asDecimal := LongIntPtr(pSymTable[i].addr)^;
                    END;
                END;
            asHex := asDecimal;

            IF asHex = - 1 THEN
                BEGIN
                WriteLn(kDontKnow);
                GetPromptedValue := FALSE;
                END;
            END
        ELSE
            BEGIN
            gotNegation := FALSE;
            FOR i := 1 TO length(s) DO
                BEGIN
                ch := s[i];

                digit := - 1;
                IF ch IN ['0'..'9'] THEN
                    digit := ord(ch) - ord('0')
                ELSE IF ch IN ['-'] THEN
                    gotNegation := true
                ELSE IF ch IN ['A'..'F'] THEN
                    BEGIN
                    digit := 10 + ord(ch) - ord('A');
                    asDecimal := - 1;
                    END
                ELSE
                    BEGIN
                    asDecimal := - 1;
                    asHex := - 1;
                    WriteLn(kDontKnow);
                    GetPromptedValue := FALSE;
                    Exit(GetPromptedValue)
                    END;

                IF digit >= 0 THEN
                    BEGIN
                    IF asDecimal >= 0 THEN
                        asDecimal := 10 * asDecimal + digit;
                    IF asHex >= 0 THEN
                        asHex := 16 * asHex + digit;
                    END;
                END;
            IF gotNegation THEN
                BEGIN
                IF (asDecimal >= 0) THEN
                    asDecimal := - asDecimal;
                IF asHex >= 0 THEN
                    asHex := - asHex;
                END;
            END;
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

FUNCTION GetPromptedNumber(prompt: StringPtr;
                           VAR asDecimal, asHex: Longint): BOOLEAN; { returns TRUE iff a valid
                                                                     number is typed; if it returns
                                                                     FALSE but the parameters are
                                                                     0, then the user typed only a
                                                                     return }

    VAR
        symbol:             BOOLEAN;

    BEGIN
    GetPromptedNumber := GetPromptedValue(prompt, asDecimal, asHex, FALSE, symbol);
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

FUNCTION GetPromptedNumberWithDefault(prompt: StringPtr;
                                      default: INTEGER): INTEGER;
{ Returns a number typed by the user.  Returns the default if a return is typed. }

    VAR
        s:                    Str255;

    BEGIN
    s := concat(ConcatNumber(concat(prompt^, ' [default = '), default), ']?:');
    IF GetPromptedNumber(@s, asDecimal, asHex) THEN
        GetPromptedNumberWithDefault := asDecimal
    ELSE
        GetPromptedNumberWithDefault := default;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

FUNCTION GetPromptedStringWithDefault(prompt: StringPtr;
                                      default: StringPtr;
                                      PROCEDURE helpProc): Str255;
{ Returns a string typed by the user.  Returns the default if a return is typed. }

    VAR
        s:                    Str255;

    BEGIN
    s := concat(prompt^, ' [default = ', default^, ']?:');
    s := GetPromptedString(@s, helpProc);
    IF s <> '' THEN
        GetPromptedStringWithDefault := s
    ELSE
        GetPromptedStringWithDefault := default^;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}
{$IFC IncludeDisassembler}
PROCEDURE ShowDisasmMemory(startAddress, numBytes: Longint);

    VAR
        idx:                INTEGER;
        BytesUsed:            INTEGER;
        opCode, Operand, Comment: DisAsmStr80;

    BEGIN
    WHILE numBytes > 0 DO
        BEGIN
        Disassembler(0, BytesUsed, startAddress, opCode, Operand, Comment, @Lookup);
        Write('    ');
        WritePtr(startAddress);
        Write(':  '); WriteLn(opCode, ' ', Operand, ' ', Comment);
        numBytes := numBytes - BytesUsed;
        startAddress := startAddress + BytesUsed;
        END;
    pMoreMem := startAddress;
    END;
{$EndC}

{$EndC}

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

PROCEDURE ShowMemory(startAddress, numBytes: Longint);

    VAR
        i:                    INTEGER;
        addr:                Longint;
        lines:                INTEGER;
        numeric:            STRING[40];
        ascii:                STRING[16];
        numPos:             INTEGER;
        ascPos:             INTEGER;
        decNumber:            Longint;
        chCode:             INTEGER;
        j:                    INTEGER;

{--------------------------------------------------------------------------------------------------}

    PROCEDURE BlankLine;

        CONST
            k8Spaces            = '        ';

        BEGIN
        ascii := concat(k8Spaces, k8Spaces);
        numeric := concat(ascii, ascii, k8Spaces);
        numPos := 0;
        ascPos := 0;
        END;

{--------------------------------------------------------------------------------------------------}

    PROCEDURE PrintLine;

        BEGIN
        WriteLn(numeric, '  ', ascii);
        END;

    BEGIN
    IF Odd(startAddress) THEN
        WriteLn('Odd Address')
    ELSE IF numBytes > 0 THEN
        BEGIN
        BlankLine;

        FOR i := 0 TO (numBytes - 1) DIV 2 DO
            BEGIN
            lines := 0;
            addr := startAddress + i + i;

            IF (i MOD 8) = 0 THEN
                BEGIN
                IF i > 0 THEN
                    BEGIN
                    PrintLine;
                    BlankLine;
                    lines := lines + 1;
                    END;
                IF IsUserBreak | (lines > 20) THEN
                    BEGIN
                    WriteLn('More… [M]: ');
                    Exit(ShowMemory);
                    END;
                Write('    ');
                WritePtr(addr);
                Write(':  ');
                END;

            decNumber := IntegerPtr(addr)^;
            FOR j := 4 DOWNTO 1 DO
                BEGIN
                numeric[numPos + j] := kHexDigits[BAND(decNumber, 15) + 1];
                decNumber := BSR(decNumber, 4);
                END;

            decNumber := IntegerPtr(addr)^;
            FOR j := 2 DOWNTO 1 DO
                BEGIN
                chCode := BAND(decNumber, 255);
                IF (chCode < $20) | (chCode > $D8) | (chCode = $7F) THEN { control, unassigned, or
                                                                          DEL }
                    chCode := ord('•');
                ascii[ascPos + j] := CHR(chCode);
                decNumber := BSR(decNumber, 8);
                END;

            numPos := numPos + 5;
            ascPos := ascPos + 2;

            pMoreMem := addr + 2;
            END;

        PrintLine;
        END;
    END;

{$IFC qDebug}
{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

FUNCTION ShowHierarchy(obj: TObject;
                       theClass: ObjClassID): Longint;

    VAR
        inspClass:            MAName;
        size:                Longint;
        super:                ObjClassID;
        shown:                INTEGER;

    BEGIN
    GetClassNameFromID(theClass, inspClass);            { srf 88.9.7 }

    IF inspClass = kInvalidObj THEN
        BEGIN
        size := GetHandleSize(Handle(obj));
        ShowMemory(ord(Handle(obj)^), size);
        END
    ELSE
        BEGIN
        size := GetClassSizeFromID(theClass);
        super := GetSuperClassID(theClass);
        IF super = kNilClass THEN                        { it is a root class, so skip class ptr }
            shown := sizeof(ObjClassID)
        ELSE
            shown := ShowHierarchy(obj, super);
        IF shown <= size THEN
            BEGIN
            GetClassNameFromID(theClass, inspClass);
            WriteLn(' ', inspClass);
            IF size > sizeof(ObjClassID) THEN            { don't show it if there are no fields }
                ShowMemory(ord(Handle(obj)^) + shown, size - shown);
            END;
        END;

    ShowHierarchy := size;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

PROCEDURE ShowFields(obj: TObject;
                     doInspect: BOOLEAN);

    VAR
        i:                    Longint;
        s:                    Longint;
        objName:            MAName;

    BEGIN
    IF ord(obj) = - 1 THEN
        Write('')
    ELSE IF ord(obj) = - 2 THEN
        WriteLn('  No object at that level (not a method).')
    ELSE IF VerboseIsObject(obj) THEN
        BEGIN
        IF doInspect THEN
            CallInspector(obj, pInspectProc)
        ELSE
            BEGIN
            i := ShowHierarchy(obj, GetClassID(obj));
            s := GetHandleSize(Handle(obj));
            IF i < s THEN
                BEGIN
                WriteLn('rest of handle:');
                ShowMemory(ord(Handle(obj)^) + i, s - i);
                END;
            END;
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAUtilitiesRes}                                     { Shouldn't be unloaded }

PROCEDURE GetLevel(level: INTEGER;
                   topFrame: Longint;
                   VAR calleeFrame, itsFrame: Longint);

    VAR
        i:                    INTEGER;

    BEGIN
    calleeFrame := topFrame;
    IF Odd(calleeFrame) THEN
        itsFrame := calleeFrame
    ELSE
        BEGIN
        itsFrame := LongIntPtr(calleeFrame)^;
        FOR i := 1 TO level DO
            IF Odd(itsFrame) | (itsFrame >= Longint(GetA5)) | (itsFrame <= calleeFrame) THEN
                itsFrame := calleeFrame
            ELSE
                BEGIN
                calleeFrame := itsFrame;
                itsFrame := LongIntPtr(itsFrame)^;
                END;
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

PROCEDURE GetFrameInfo(calleeFrame: Longint;
                       ppc: Longint;
                       VAR callerFrame: Longint;
                       VAR itsFrame: Longint;
                       VAR itsReceiver: TObject;
                       VAR className: MAName;
                       VAR procName: MAName;
                       VAR rcvrHandle: HexAddress;
                       VAR rcvrClass: MAName;
                       VAR theSegNum: INTEGER);

    VAR
        aStringPtr:         StringPtr;

    BEGIN
    GetProcName(ppc, className, procName);
    theSegNum := GetSegFromPC(ppc);

    GetLevel(1, calleeFrame, itsFrame, callerFrame);

    rcvrClass := kInvalidObj;
    IF Odd(itsFrame) | (length(className) = 0) THEN
        BEGIN
        Longint(itsReceiver) := - 2;
        rcvrHandle := kInvalidObj;
        END
    ELSE
        BEGIN
        Longint(itsReceiver) := LongIntPtr(itsFrame + 8)^;
        aStringPtr := StringPtr(@rcvrHandle);
        PointerToHex(itsReceiver, aStringPtr^, 8);
        IF IsObject(itsReceiver) THEN
            GetClassNameFromID(GetClassID(itsReceiver), rcvrClass);
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

FUNCTION GetRcvrAtLevel(level: INTEGER;
                        topFrame: Longint): TObject;

    VAR
        calleeFrame, callerFrame, itsFrame: Longint;
        receiver:            TObject;
        className, procName, rcvrClass: MAName;
        rcvrHandle:         HexAddress;
        dummy:                INTEGER;

    BEGIN
    itsFrame := topFrame;
    REPEAT
        calleeFrame := itsFrame;
        GetFrameInfo(calleeFrame, calleeFrame + 4, callerFrame, itsFrame, receiver, className,
                     procName, rcvrHandle, rcvrClass, dummy);
        level := level - 1;
    UNTIL (level < 0) | (calleeFrame = itsFrame);
    GetRcvrAtLevel := receiver;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

PROCEDURE ShowLocals(level: INTEGER;
                     topFrame: Longint);

    VAR
        startAt, finishAt:    Longint;
        itsFrame, calleeFrame: Longint;

    BEGIN
    GetLevel(level, topFrame, calleeFrame, itsFrame);
    startAt := max(calleeFrame + 8, itsFrame - 80);
    finishAt := itsFrame;
    ShowMemory(startAt, finishAt - startAt);
    IF pMoreMem >= finishAt THEN
        WriteLn('  The first locals declared appear last or are in reg''s.');
    END;

{
 calleeFrame: PREV LINK
 calleeFrame+4: PREV RA
 calleeFrame+8: PREV PARAMS
 MY LOCALS
 itsFrame: MY LINK
 itsFrame+4: MY RA
 itsFrame+8: MY PARAMS (IF A METHOD: callerFrame+8=SELF)
 NEXT LOCALS
 callerFrame: NEXT LINK
 }

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

PROCEDURE ShowParameters(level: INTEGER;
                         topFrame: Longint);

    VAR
        startAt, finishAt:    Longint;
        itsFrame, callerFrame: Longint;

    BEGIN
    GetLevel(level + 1, topFrame, itsFrame, callerFrame);
    startAt := itsFrame + 8 + 4 * ord(ord(GetRcvrAtLevel(level, topFrame)) > 0);
    finishAt := Min(startAt + 80, callerFrame);
    WriteLn('  The last argument you declared is shown first below.');
    ShowMemory(startAt, finishAt - startAt);
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

PROCEDURE ShowNames(VAR procName: MAName;
                    segNum: INTEGER);

    BEGIN
    Write(procName);
    IF segNum > 0 THEN
        Write(' Seg#: ', segNum: 1);
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

PROCEDURE ShowWhich(which: ZT;
                    VAR procName: MAName;
                    segNum: INTEGER);

    BEGIN
    CASE which OF
        tBegin:
            Write('Begin  ');
        tEnd:
            Write('End    ');
        tExit:
            Write('Exit   ');
        tBeginEndPair:
            Write('BegEnd ');
        tSysError:
            Write('SysErr ');
        tProgBreak:
            Write('Break  ');
        tVBL:
            Write('VBL Break  ');
    END;

    ShowNames(procName, segNum);
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

PROCEDURE ShowSymbolWhich(which: ZT;
                          VAR procName: MAName;
                          segNum: INTEGER);

    BEGIN
    CASE which OF
        tBegin:
            Write('>');
        tEnd:
            Write('<');
        tExit:
            Write('^ Exit: ');
        tBeginEndPair:
            Write('');
        tSysError:
            Write(': SysErr');
        tProgBreak:
            Write(': Break');
        tVBL:
            Write(': VBL Break');
    END;
    ShowNames(procName, segNum);
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

PROCEDURE ShowRecent;
{ show recent history of pc.  Indents to show nesting level }

    CONST
        kIndentMax            = 31;                        { must be a power of 2 minus 1 }
        kIndentAmount        = 2;                        { number of spaces per nesting level }
        kDupClassName        = '=';
        kFailureProc        = 'FAILURE';

    VAR
        nextProcName, className, lastClassName: MAName;
        procName:            MAName;
        i:                    INTEGER;
        nexti:                INTEGER;
        pc:                 Longint;
        indentLevel, maxIndentLevel: INTEGER;
        aString:            Str255;
        aZt:                ZT;

    BEGIN
    { get the maximum indenting or outdenting level first }
    maxIndentLevel := 0;
    i := BAND(pRecentIndex + 1, kRecent);                { absolute value, modulo kRecent }
    REPEAT
        WITH pRecentPC[i] DO
            IF thePC <> 0 THEN
                BEGIN
                CASE theZT OF
                    tBegin:
                        maxIndentLevel := maxIndentLevel + kIndentAmount;
                    tEnd, tBeginEndPair:
                        maxIndentLevel := maxIndentLevel - kIndentAmount;
                    tExit: ;
                END;
                END;
        i := BAND(i + 1, kRecent);                        { absolute value, modulo kRecent }
    UNTIL i = pRecentIndex;

    { try to intelligently set a starting indent level }
    IF maxIndentLevel < 0 THEN                            { some outdenting required }
        indentLevel := Min(abs(maxIndentLevel), (kIndentMax + 1) DIV 2)
    ELSE
        indentLevel := 0;                                { only indents }

    lastClassName := '';
    aString := '| | | | | | | | | | | | | | | ';
    i := BAND(pRecentIndex + 1, kRecent);                { absolute value, modulo kRecent }
    REPEAT
        WITH pRecentPC[i] DO
            IF thePC <> 0 THEN
                BEGIN
                GetProcName(ord(@thePC), className, procName);
                aZt := theZT;
                nexti := BAND(i + 1, kRecent);
                IF nexti <> pRecentIndex THEN
                    BEGIN
                    GetMethodName(ord(@pRecentPC[nexti].thePC), nextProcName);
                    IF nextProcName = procName THEN
                        BEGIN
                        aZt := tBeginEndPair;
                        i := nexti;
                        END;
                    END;
                CASE aZt OF
                    tBegin, tBeginEndPair:
                        indentLevel := BAND(indentLevel + kIndentAmount, kIndentMax);
                END;
                aString[0] := CHR(indentLevel);
                Write(aString);
                CASE aZt OF
                    tEnd, tBeginEndPair:
                        indentLevel := BAND(indentLevel - kIndentAmount, kIndentMax);
                    tExit: ;
                END;
                IF IsUserBreak THEN
                    LEAVE;
                IF (lastClassName = className) & (length(className) <> 0) THEN
                    BEGIN
                    Delete(procName, 1, length(className));
                    insert(kDupClassName, procName, 1);
                    END;
                lastClassName := className;
                ShowSymbolWhich(aZt, procName, - 1);
                WriteLn;
                IF (aZt = tExit) | ((length(className) = 0) & (procName = kFailureProc)) THEN
                    WriteLn('------------------------------');
                END;
        i := BAND(i + 1, kRecent);                        { absolute value, modulo kRecent }
    UNTIL i = pRecentIndex;
    WriteLn;

    pMoreMem := - 1;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

PROCEDURE ShowWhere;

    BEGIN
    ShowWhich(which, procName, segNum);
    IF ord(receiver) > 0 THEN
        Write('  Self: ', rcvrHandle, ' is ', rcvrClass);
    WriteLn;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

PROCEDURE ShowStatus;

    VAR
        i:                    INTEGER;

    BEGIN
    Write('Trace: ');
    IF pTraceToggle THEN
        Write('ON;  ')
    ELSE
        Write('OFF; ');

    {$Ifc qPerform}
    Write('Performance Monitor: ');
    IF oldState THEN
        Write('ON;  ')
    ELSE
        Write('OFF; ');
    {$Endc}

    IF pBreakCount > 0 THEN
        BEGIN
        Write('Break[s] set at: ');
        FOR i := 1 TO pBreakCount DO
            BEGIN
            IF i > 1 THEN
                Write(', ');
            IF pBreakClass[i] <> '' THEN
                Write(pBreakClass[i], '.', pBreakProc[i])
            ELSE
                Write(pBreakProc[i]);
            END;
        END
    ELSE
        Write('No Break set.');

    WriteLn;

    Write('Last Broke at: ');
    ShowWhere;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

PROCEDURE ShowStack;

    VAR
        startLevel:         INTEGER;
        interrupted:        BOOLEAN;
    {??? moved strings out to this level to help reduce the stack rqs of recursion.
    Eventually should fix even better than this ???}
        className:            MAName;
        procName:            MAName;
        rcvrClass:            MAName;
        rcvrHandle:         HexAddress;

{--------------------------------------------------------------------------------------------------}

    PROCEDURE ShowLevel(level: INTEGER;
                        calleeFrame, ppc: Longint);

        VAR
            callerFrame:        Longint;
            itsFrame:            Longint;
            receiver:            TObject;
            segNum:             INTEGER;

        BEGIN
        GetFrameInfo(calleeFrame, ppc, callerFrame, itsFrame, receiver, className, procName,
                     rcvrHandle, rcvrClass, segNum);

        IF calleeFrame <> itsFrame THEN
            BEGIN
            nextLevel := level + 1;
            nextFrame := itsFrame;
            pNextPC := itsFrame + 4;
            IF nextLevel < startLevel + 10 THEN
                ShowLevel(nextLevel, nextFrame, pNextPC)
            ELSE
                pMoreMem := 0;                            {Signal that "More" command is available}
            END;

        IF NOT interrupted THEN
            BEGIN
            Write(' ', level: 3, ' ');
            WritePtr(calleeFrame);
            Write(': ');

            { retrieve names for this frame again }
            GetFrameInfo(calleeFrame, ppc, callerFrame, itsFrame, receiver, className, procName,
                         rcvrHandle, rcvrClass, segNum);

            ShowNames(procName, segNum);
            IF ord(receiver) > 0 THEN
                Write('  Self: ', rcvrHandle, ' is ', rcvrClass);
            WriteLn;
            interrupted := IsUserBreak;
            END;
        END;

    BEGIN
    pMoreMem := - 1;
    interrupted := FALSE;
    startLevel := nextLevel;

    ShowLevel(startLevel, nextFrame, pNextPC);

    IF pMoreMem = 0 THEN
        WriteLn('More… [M]: ');
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAUtilitiesRes}                                     { Shouldn't be unloaded }
{$Push} {$Z+}

PROCEDURE EachFrameDo(calleeFrame, ppc: Longint;
                      PROCEDURE DoToFrame(calleeFrame: Longint;
                                          ppc: Longint;
                                          callerFrame: Longint;
                                          itsFrame: Longint));

    PROCEDURE DoLevel(calleeFrame, ppc: Longint);

        VAR
            callerFrame:        Longint;
            itsFrame:            Longint;
            nextFrame:            Longint;
            pNextPC:            Longint;

        BEGIN
        GetLevel(1, calleeFrame, itsFrame, callerFrame);
        DoToFrame(calleeFrame, ppc, callerFrame, itsFrame);
        IF calleeFrame <> itsFrame THEN
            BEGIN
            nextFrame := itsFrame;
            pNextPC := itsFrame + 4;
            DoLevel(nextFrame, pNextPC)
            END;
        END;

    BEGIN
    DoLevel(calleeFrame, ppc);
    END;
{$Pop}

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

PROCEDURE ShowTempSpace(VAR lockedSpace, totalSpace: Longint);

    VAR
        seg:                Handle;

    BEGIN
    lockedSpace := TotalTempSize(true, seg);
    totalSpace := TotalTempSize(FALSE, seg);

    WriteLn('  Current temp space: locked = ', lockedSpace: 1, ', unlocked = ', totalSpace -
            lockedSpace: 1, ', total = ', totalSpace: 1);

    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

PROCEDURE ShowHeapInfo;

    VAR
        codeRes:            Longint;
        codeShort:            Longint;
        lockedSpace:        Longint;
        lowSpaceRes:        Longint;
        okCode:             BOOLEAN;
        okLowSpace:         BOOLEAN;
        oldPerm:            BOOLEAN;
        oldRsrcUse:         Longint;
        purgeSpace:         Longint;
        totalSpace:         Longint;

    BEGIN
    oldRsrcUse := gMaxLockedRsrc;

    {== S T A C K ==}
    WriteLn('STACK');
    WriteLn('  Current total stack = ', pStackSpace: 1, '           Maximum stack used = ',
            gMaxStackDepth: 1);
    WriteLn('  Current procedure stack = ', pProcStack: 1, '           Available stack = ',
            ord(GetCurStackBase) - ord(GetApplLimit): 1);

    IF pBreakStack < $7FFFFFFF THEN
        WriteLn('Break at total stack space = ', pBreakStack: 1);
    IF pBrProcStack < $7FFFFFFF THEN
        WriteLn('Break at procedure stack space = ', pBrProcStack: 1);

    {== R E S E R V E S ==}
    WriteLn('RESERVES');
    DoChangeReserve(FALSE, codeRes, codeShort, lowSpaceRes, okCode, okLowSpace);

    Write('  code = ', codeRes: 1);
    IF okCode THEN
        Write(' (OK)')
    ELSE
        Write(' (low: ', codeShort: 1, ')');

    Write('     low space = ', lowSpaceRes: 1);
    IF okLowSpace THEN
        Write(' (OK)')
    ELSE
        Write(' (gone)');

    Write('  allocation flag: ');
    IF pPermFlag THEN
        WriteLn('permanent')
    ELSE
        WriteLn('temporary');

    {== T E M P  S P A C E ==}
    WriteLn('TEMP SPACE');
    ShowTempSpace(lockedSpace, totalSpace);

    purgeSpace := totalSpace - codeRes;
    IF purgeSpace > (totalSpace - lockedSpace) THEN
        purgeSpace := totalSpace - lockedSpace;

    IF purgeSpace >= 0 THEN
        WriteLn('  Purgeable temp space = ', purgeSpace: 1)
    ELSE
        WriteLn('  Needed reserve handle size = ', - purgeSpace: 1);

    {== O T H E R ==}
    WriteLn('OTHER');
    CheckRsrcUsage;

    Write('  Max resource usage = ', gMaxLockedRsrc: 1);
    IF oldRsrcUse <> gMaxLockedRsrc THEN
        WriteLn(' (new)')
    ELSE
        WriteLn;

    gMaxLockedRsrc := oldRsrcUse;                        { so we get the '(new)' indications again }

    oldPerm := PermAllocation(true);
    totalSpace := FreeMem;
    oldPerm := PermAllocation(oldPerm);

    WriteLn('  (permanent) FreeMem = ', totalSpace: 1, '            Free master pointers = ',
            GetFreeMastersCount: 1);
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

PROCEDURE HeapCmd;

    VAR
        ch:                 CHAR;
        decNum:             Longint;
        done:                BOOLEAN;
        hexNum:             Longint;
        x:                    Longint;
        y:                    Longint;

        id:                 INTEGER;
        name:                Str255;
        nSeg:                INTEGER;
        seg:                Handle;
        t:                    ResType;

        codeRes:            Longint;
        codeShort:            Longint;
        lowSpaceRes:        Longint;
        okCode:             BOOLEAN;
        okLowSpace:         BOOLEAN;
        oldPerm:            BOOLEAN;

    PROCEDURE helpProc;

        BEGIN
        WriteLn;
        WriteLn('+ -- set breakpoint on procedure stack usage');
        WriteLn('B -- set breakpoint on total stack usage');
        WriteLn('D -- reset maximum stack depth');
        WriteLn('I -- show heap/stack info');
        WriteLn('M -- show heap/stack info AND MaxMem');
        WriteLn('R -- show/set heap reserve');
        WriteLn('S -- list LOADED segments');
        WriteLn('ß (option-S) -- list ALL segments');
        WriteLn;
        END;

    PROCEDURE ShowSegments(allSegments: BOOLEAN);
    { Show segment information.  if allSegments is true then also show unloaded & purged }

        VAR
            i:                    INTEGER;

        BEGIN
        codeRes := 0;                                    { counts size of code segments }

        nSeg := GetHandleSize(Handle(gCodeSegs)) DIV sizeof(Handle);

        WriteLn('Total # segments = ', nSeg: 1);
        IF allSegments THEN
            WriteLn(
        '• = resident, L = loaded, U = unloaded (and relocatable), '' '' = purged (or never loaded)'
                    )
        ELSE
            WriteLn('• = resident, L = loaded');

        FOR i := 1 TO nSeg DO
            BEGIN
            seg := gCodeSegs^^[i];
            IF allSegments | (NOT IsHandlePurged(seg) & isHandleLocked(seg)) THEN
                BEGIN
                GetResInfo(seg, id, t, name);

                WritePtr(seg);

                Write('  Seg#:', id: 3, ' ');

                IF gIsResidentSeg^^[i] THEN
                    Write('• ')
                ELSE IF IsHandlePurged(seg) THEN
                    Write('  ')
                ELSE IF gIsLoadedSeg^^[i] THEN
                    Write('L ')
                ELSE
                    Write('U ');

                Write(name, ' ': 25 - length(name), ' ');

                WriteLn(pSegSize^^[i]: 6, ' bytes');

                codeRes := codeRes + pSegSize^^[i] + 8;
                END;
            END;

        WriteLn;
        WriteLn('Total loaded code = ', codeRes: 1);
        ShowTempSpace(x, y);
        END;

    BEGIN
    done := FALSE;
    REPEAT
        ch := GetPromptedChar(AtStr('Heap/Stack Cmd'), AtStr('+BDIMRSß'), helpProc);

        CASE ch OF
            '+':
                BEGIN
                IF GetPromptedNumber(AtStr('Break at what procedure stack usage?: '), decNum,
                                     hexNum) THEN

                    IF decNum = 0 THEN
                        pBrProcStack := $7FFFFFFF
                    ELSE IF decNum > 0 THEN
                        pBrProcStack := decNum;

                ShowHeapInfo;

                done := true;
                END;

            'B':
                BEGIN
                IF GetPromptedNumber(AtStr('Break at what total stack usage?: '), decNum,
                   hexNum) THEN
                    IF decNum = 0 THEN
                        pBreakStack := $7FFFFFFF
                    ELSE IF decNum > 0 THEN
                        pBreakStack := decNum;

                ShowHeapInfo;

                done := true;
                END;

            'D':
                BEGIN
                gMaxStackDepth := - 1;

                ShowHeapInfo;

                done := true;
                END;

            'I':
                BEGIN
                ShowHeapInfo;
                done := true;
                END;

            'M':
                BEGIN
                oldPerm := PermAllocation(true);
                x := MaxMem(decNum);
                oldPerm := PermAllocation(oldPerm);

                ShowHeapInfo;

                WriteLn('(permanent) MaxMem = ', x: 1);

                done := true;
                END;

            'R':
                BEGIN
                DoChangeReserve(true, codeRes, codeShort, lowSpaceRes, okCode, okLowSpace);
                ShowHeapInfo;
                done := true;
                END;

            'S':
                BEGIN
                ShowSegments(FALSE);

                done := true;
                END;

            'ß':
                BEGIN
                ShowSegments(true);

                done := true;
                END;

            OTHERWISE
                done := true;
        END;
    UNTIL done;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

PROCEDURE PositionDebugWindow(where: CHAR);

    VAR
        theEvent:            EventRecord;

    BEGIN
    CASE where OF
        'B':
            BEGIN
            SendBehind(pDebugWindow.fWMgrWindow, NIL);
            WHILE GetNextEvent(activMask, theEvent) DO; { suck up the activate/deactivate }
            HiliteWindow(pDebugWindow.fWMgrWindow, true);
            END;
        'F':
            BringToFront(pDebugWindow.fWMgrWindow);
    END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

PROCEDURE WindCmd;

    CONST
        kVMargin            = 4;
        kHMargin            = 4;

    VAR
        done:                BOOLEAN;
        ch:                 CHAR;
        aTextStyle:         TextStyle;

    PROCEDURE helpProc;

        BEGIN
        WriteLn;
        WriteLn('B -- send debug window to the back');
        WriteLn('F -- bring debug window to front');
        WriteLn('ƒ -- specify a font');
        WriteLn('S -- specify a font size');
        WriteLn;
        END;

    PROCEDURE InstallTheStyle(aTextStyle: TextStyle);

        VAR
            zoomedOutSize:        Point;

        BEGIN
        {$Push} {$H-}
        zoomedOutSize := VPtToPt(pDebugView.fSize);
        {$Pop}
        WITH zoomedOutSize DO
            BEGIN
            v := (2 * kVMargin) + (pDebugView.fFontHeight * (pDebugView.fRows));
            v := max(kSBarSize * 4, v + kSBarSize);
            h := max(kSBarSize * 4, h + kSBarSize);
            END;

        pDebugWindow.SetResizeLimits(gStdWSizeRect.topLeft, zoomedOutSize);
        pDebugView.InstallTextStyle(aTextStyle);
        pDebugView.ForceRedraw;
        END;

    PROCEDURE FontHelpProc;

        VAR
            theCount, i:        INTEGER;
            h:                    Handle;
            oldResLoad:         BOOLEAN;
            theID:                INTEGER;
            theType:            ResType;
            name:                Str255;

        BEGIN
        WriteLn;
        theCount := CountResources('FOND');
        FOR i := 1 TO theCount DO
            BEGIN
            oldResLoad := GetResLoad;
            SetResLoad(FALSE);
            h := GetIndResource('FOND', i);
            IF h <> NIL THEN
                BEGIN
                GetResInfo(h, theID, theType, name);
                SetResLoad(oldResLoad);
                WriteLn(name);
                END
            ELSE
                SetResLoad(oldResLoad);
            END;
        END;

    BEGIN
    done := FALSE;
    REPEAT
        ch := GetPromptedChar(AtStr('Window Cmd'), AtStr('BFƒS'), helpProc);

        CASE ch OF
            'B', 'F':
                BEGIN
                PositionDebugWindow(ch);
                done := true;
                END;
            'ƒ':                                        {??? from a menu some other time }
                BEGIN
                aTextStyle := pDebugView.fTextStyle;
                aTextStyle.tsFont := GetFontNum(GetPromptedString(AtStr('Enter font name?: '),
                                                                  FontHelpProc));
                InstallTheStyle(aTextStyle);
                done := true;
                END;
            'S':                                        {??? from a menu some other time }
                BEGIN
                IF GetPromptedNumber(AtStr('Enter font size?: '), asDecimal, asHex) THEN
                    BEGIN
                    aTextStyle := pDebugView.fTextStyle;
                    aTextStyle.tsSize := asDecimal;
                    InstallTheStyle(aTextStyle);
                    END;
                done := true;
                END;
            OTHERWISE
                done := true;
        END;
    UNTIL done;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

PROCEDURE SetBreakCmd;

    VAR
        done:                BOOLEAN;
        ch:                 CHAR;
        aClassName, aProcName: MAName;

    BEGIN
    IF pBreakCount < 10 THEN
        BEGIN
        IF GetPromptedNames(AtStr('Break at [Typename.ProcName or ProcName]?: '), aClassName,
                            aProcName) THEN
            BEGIN
            pBreakCount := pBreakCount + 1;
            pBreakClass[pBreakCount] := aClassName;
            pBreakProc[pBreakCount] := aProcName;
            END
        END
    ELSE
        WriteLn('Already have maximum breakpoints set!');
    ShowStatus;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

PROCEDURE ClrBreakCmd;

    VAR
        aString:            Str255;
        whichBreak:         Longint;

    PROCEDURE ClrBreakHelp;

        VAR
            i:                    INTEGER;

        BEGIN
        WriteLn;
        WriteLn('A - All breakpoints');
        FOR i := 1 TO pBreakCount DO
            BEGIN
            Write(i: 1, ' - ');
            IF pBreakClass[i] <> '' THEN
                WriteLn(pBreakClass[i], '.', pBreakProc[i])
            ELSE
                WriteLn(pBreakProc[i]);
            END;
        END;

    BEGIN
    CASE pBreakCount OF
        0:
            WriteLn('No breakpoints are set!.');
        1:
            BEGIN
            pBreakCount := 0;
            WriteLn('Cleared the breakpoint.');
            END;
        OTHERWISE
            BEGIN
            aString := concat(ConcatNumber('Which breakpoint[1-', pBreakCount), ',A]?:');
            aString := GetPromptedString(@aString, ClrBreakHelp);
            UprStr255(aString);
            IF aString = 'A' THEN
                BEGIN
                pBreakCount := 0;
                WriteLn('Cleared all the breakpoints.');
                END
            ELSE IF aString <> '' THEN
                BEGIN
                StringToNum(aString, whichBreak);
                IF (whichBreak > 0) & (whichBreak <= pBreakCount) THEN
                    BEGIN
                    WHILE whichBreak < pBreakCount DO
                        BEGIN
                        pBreakClass[whichBreak] := pBreakClass[whichBreak + 1];
                        pBreakProc[whichBreak] := pBreakProc[whichBreak + 1];
                        whichBreak := whichBreak + 1;
                        END;
                    pBreakCount := pBreakCount - 1;
                    WriteLn('Cleared the breakpoint.');
                    END;
                END;
            END;
    END;
    ShowStatus;
    END;

{--------------------------------------------------------------------------------------------------}
{$Ifc qPerform}
{$S MADebugger}

PROCEDURE PerfCmd;

    VAR
        done:                BOOLEAN;
        ch:                 CHAR;
        aBool:                BOOLEAN;
        perfErr:            INTEGER;
        s:                    Str255;
        ms:                 INTEGER;
        apName:             Str255;
        apRefnum:            INTEGER;
        apParam:            Handle;

    PROCEDURE helpProc;

        BEGIN
        WriteLn;
        WriteLn('D -- Dump to output file');
        WriteLn('E -- End the tools and free their storage');
        WriteLn('I -- Init performance tools');
        WriteLn('T -- Toggle tools on and off');
        WriteLn;
        END;

    PROCEDURE appCodeTypeHelpProc;

        BEGIN
        WriteLn;
        WriteLn('Please specify the resource type to measure');
        WriteLn;
        END;

    PROCEDURE romNameHelpProc;

        BEGIN
        WriteLn;
        WriteLn('Please specify the ROM name');
        WriteLn;
        END;

    PROCEDURE reportFileHelpProc;

        BEGIN
        WriteLn;
        WriteLn('Please specify a file name for the report');
        WriteLn;
        END;

    BEGIN
    done := FALSE;
    REPEAT
        ch := GetPromptedChar(AtStr('Performance Cmd'), AtStr('DEIT'), helpProc);

        CASE ch OF
            'D':
                BEGIN
                IF pTP2PerfGlobals <> NIL THEN
                    BEGIN
                    WriteLn('Dump performance tools data.  Press Return to take the default…');
                    GetAppParms(apName, apRefnum, apParam);
                    s := concat(apName, '.perf');
                    perfErr := PerfDump(pTP2PerfGlobals,
                                        GetPromptedStringWithDefault(AtStr('  reportFile'), @s,
                                        reportFileHelpProc), GetPromptedNumberWithDefault(AtStr(
                                        '  doHistogram (TRUE=1/FALSE=0)'), 0) = 1,
                                        GetPromptedNumberWithDefault(AtStr('  rptFileColumns'),
                               80));
                    IF perfErr <> noErr THEN
                        WriteLn('Error: ', perfErr, ' while dumping');
                    END
                ELSE
                    WriteLn('Not initialized!');
                done := true;
                END;
            'E':
                BEGIN
                IF pTP2PerfGlobals <> NIL THEN
                    BEGIN
                    TermPerf(pTP2PerfGlobals);
                    pTP2PerfGlobals := NIL;
                    END
                ELSE
                    WriteLn('Not initialized!');
                done := true;
                END;
            'I':
                BEGIN
                IF pTP2PerfGlobals = NIL THEN
                    BEGIN
                    WriteLn('Init performance tools.  Press Return to take the default…');
                    { set the default }
                    CASE gConfiguration.machineType OF
                        envMac, envXL, env512KE, envMacPlus, envSE:
                            ms := 10;
                        OTHERWISE
                            ms := 4;
                    END;
                    aBool := InitPerf(pTP2PerfGlobals,
                                      GetPromptedNumberWithDefault(AtStr('  timerCount'), ms),
                                      GetPromptedNumberWithDefault(AtStr('  codeAndROMBucketSize'),
                                                                   8),
                                      GetPromptedNumberWithDefault(AtStr('  doROM (TRUE=1/FALSE=0)'
                                                                          ), 0) = 1,
                                      GetPromptedNumberWithDefault(AtStr(
                                                                      '  doAppCode (TRUE=1/FALSE=0)'
                                                                         ), 1) = 1,
                                      GetPromptedStringWithDefault(AtStr('  appCodeType'),
                                                                   AtStr('CODE'),
                                                                   appCodeTypeHelpProc),
                                      GetPromptedNumberWithDefault(AtStr('  romID'), 0),
                                      GetPromptedStringWithDefault(AtStr('  romName'), AtStr(''),
                                                                   romNameHelpProc),
                                      GetPromptedNumberWithDefault(AtStr('  doRAM (TRUE=1/FALSE=0)')
                                                                   , 0) = 1,
                                      GetPromptedNumberWithDefault(AtStr('  ramLow'), 0),
                                      GetPromptedNumberWithDefault(AtStr('  ramHigh'), 0),
                                      GetPromptedNumberWithDefault(AtStr('  ramBucketSize'), 8));
                    IF NOT aBool THEN
                        WriteLn('Performance tools initialization FAILED.');
                    END
                ELSE
                    WriteLn('Already initialized!');

                done := true;
                END;
            'T':
                BEGIN
                IF pTP2PerfGlobals <> NIL THEN
                    BEGIN
                    oldState := NOT oldState;
                    ShowStatus;
                    END
                ELSE
                    WriteLn('Not initialized!');
                done := true;
                END;
            OTHERWISE
                done := true;
        END;
    UNTIL done;
    END;
{$Endc}
{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

PROCEDURE ToggleCmd;

    VAR
        done:                BOOLEAN;
        ch:                 CHAR;
        i:                    INTEGER;
        theFlags:            Str255;
        newState:            BOOLEAN;

    PROCEDURE FlagInfo(desc: StringHandle;
                       addr: BooleanPtr);

        BEGIN
        HLock(Handle(desc));
        {$Push} {$H-}
        Write(desc^^, ': ');
        {$Pop}
        HUnLock(Handle(desc));
        IF addr^ THEN
            WriteLn('TRUE')
        ELSE
            WriteLn('FALSE');
        END;

    PROCEDURE helpProc;

        VAR
            i:                    INTEGER;

        BEGIN
        WriteLn;
        FOR i := 1 TO pFlagsInUse DO
            WITH pFlagTable[i] DO
                BEGIN
                Write(ch, ' -- ');
                FlagInfo(desc, addr);
                END;
        WriteLn;
        END;

    BEGIN
    done := FALSE;
    REPEAT
        theFlags := '';
        FOR i := 1 TO pFlagsInUse DO
            BEGIN
            IF pFlagTable[i].addr^ THEN
                theFlags[length(theFlags) + 1] := UprChar(pFlagTable[i].ch)
            ELSE
                theFlags[length(theFlags) + 1] := LowerChar(pFlagTable[i].ch);
            theFlags[0] := CHR(length(theFlags) + 1);
            END;

        ch := GetPromptedChar(AtStr('Toggle Flag'), @theFlags, helpProc);
        CASE ch OF
            chReturn:
                done := true;
            OTHERWISE
                BEGIN
                i := 1;
                WHILE NOT done & (i <= pFlagsInUse) DO
                    BEGIN
                    IF pFlagTable[i].ch = ch THEN
                        BEGIN
                        newState := NOT pFlagTable[i].addr^;
                        IF pFlagTable[i].actionProc <> NIL THEN
                            IF CallFlagActionProc(newState, pFlagTable[i].actionProc) THEN; {
                            discard result }
                        pFlagTable[i].addr^ := newState;
                        FlagInfo(pFlagTable[i].desc, pFlagTable[i].addr);
                        done := true;
                        END;
                    i := i + 1;
                    END;
                END;
        END;
    UNTIL done;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

PROCEDURE MainHelpProc;

    BEGIN
    WriteLn;
    Write('A5: ');
    WritePtr(GetA5);
    Write('; thePort: ');
    WritePtr(pSavedState.pFocusRec.Port);
    WriteLn;
    ShowStatus;
    WriteLn('?/Help -- Display Help');
    WriteLn('/ -- Show Status');
    WriteLn('B -- Set a breakpoint');
    WriteLn('C -- Clear a breakpoint');
    WriteLn('D -- Display Memory');
    {$IFC IncludeDisassembler}
    WriteLn('∂ (option-d) -- Disassemble Memory');
    {$EndC}
    WriteLn('E -- Enter Macsbug (or other low-level debugger)');
    WriteLn('F -- Fields');
    WriteLn('G -- Go');
    WriteLn('H -- Heap & Stack…');
    WriteLn('I -- Inspect');
    WriteLn('L -- Locals');
    WriteLn('M -- More');
    {$IFC IncludeDisassembler}
    WriteLn('µ (option-m) -- Disassemble More');
    {$EndC}
    WriteLn('O -- Output Redirection');
    WriteLn('P -- Parameters');
    {$Ifc qPerform}
    WriteLn('π (option-p) -- Performance Monitor…');
    {$Endc}
    WriteLn('Q -- Quit');
    WriteLn('R -- Recent PC history');
    WriteLn('S -- Stack Crawl');
    WriteLn('ß (option-s) -- Signal Failure(0, 0)');
    WriteLn('T -- Trace toggle');
    WriteLn('W -- Window…');
    WriteLn('X -- Toggle Flag…');
    WriteLn('Space -- Single step OVER deeper levels');
    WriteLn('Option-Space -- Single step INTO deeper levels');
    WriteLn('Cmd-BS/Cmd-CR, Arrows, Page keys -- Scroll');
    WriteLn('Cmd-` -- Break at normal entry');
    WriteLn('Cmd-Option-Shift -- Break at next procedure boundary');
    WriteLn('Cmd-Option-Control-Shift -- Break at next VBL (Danger Will Robinson!)');
    WriteLn;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

PROCEDURE DoWaiting;

    CONST
        chOptionSpace        = ' ';

    VAR
        error, message:     INTEGER;
        gotSymbol:            BOOLEAN;
        savedScript:        INTEGER;

    PROCEDURE RedirectHelpProc;

        BEGIN
        WriteLn;
        WriteLn('Please supply a valid filename.  ''>>filename'' to append to the file');
        WriteLn;
        END;

    BEGIN
    pMoreMem := - 1;
    IF NOT gInBackground THEN
        HiliteMenu(mDebug)
    ELSE IF FALSE THEN
        InstallAnNMRequest;

    WHILE waiting DO
        BEGIN
        IF pAtBreak THEN
            BEGIN
            FlushEvents(keyDownMask + autoKeyMask, 0);
            pAtBreak := FALSE;
            END;

        {$Ifc qPerform}
        ch := GetPromptedChar(AtStr('Command'), AtStr('  BCDEFGHILMOPπQRSßTWX/'), MainHelpProc);
        {$ElseC}
        ch := GetPromptedChar(AtStr('Command'), AtStr('  BCDEFGHILMOPQRSßTWX/'), MainHelpProc);
        {$Endc}
        CASE ch OF
            '/':
                BEGIN
                WriteLn;
                Write('A5: ');
                WritePtr(GetA5);
                Write('; thePort: ');
                WritePtr(pSavedState.pFocusRec.Port);
                WriteLn;
                ShowStatus;
                END;

            'B':
                SetBreakCmd;

            'C':
                ClrBreakCmd;

            'D':
                BEGIN
                IF GetPromptedNumber(AtStr('Display memory starting where?: '), asDecimal,
                   asHex) THEN
                    IF asHex <> - 1 THEN
                        ShowMemory(asHex, 16);
                END;

            {$IFC IncludeDisassembler}
            '∂':
                BEGIN
                IF GetPromptedNumber(AtStr('Disassemble memory starting where?: '), asDecimal,
                                     asHex) THEN
                    IF asHex <> - 1 THEN
                        ShowDisasmMemory(asHex, 16);
                END;
            {$EndC}
            'E':
                BEGIN
                IF qNeedsScriptManager | gConfiguration.hasScriptManager THEN
                    BEGIN
                    { Save the current script, and set it to Roman for Debugger }
                    savedScript := GetEnvirons(smKeyScript);
                    KeyScript(smRoman);
                    END;

                DebugStr('Type ''G'' to return to the MacApp debugger.');

                IF qNeedsScriptManager | gConfiguration.hasScriptManager THEN
                    KeyScript(savedScript);
                END;
            'F':
                BEGIN
                IF GetPromptedValue(AtStr(
                                        'Fields of object [hex handle, or decimal stack level #]?: '
                                          ), asDecimal, asHex, true, gotSymbol) THEN
                    IF (asDecimal >= 0) & (asDecimal < 100) & NOT gotSymbol THEN
                        ShowFields(GetRcvrAtLevel(asDecimal, pLink), FALSE)
                    ELSE
                        ShowFields(TObject(asHex), FALSE);
                END;

            'G', chSpace, chOptionSpace:
                BEGIN
                IF ch = 'G' THEN
                    WriteLn('go…');
                IF which = tSysError THEN
                    BEGIN
                    str := '';
                    ShowWhich(which, str, 0);
                    WriteLn('To proceed will be fatal or will go to another debugger.');
                    waiting := NOT (GetPromptedChar(AtStr('Want to proceed'), AtStr('NY'),
                                                    stdHelpProc) = 'Y');
                    END
                ELSE
                    waiting := FALSE;

                IF NOT waiting THEN
                    BEGIN
                    gSingleStep := ch = chOptionSpace;
                    IF ch = chSpace THEN
                        pStepOverStackSize := pStackSpace
                    ELSE
                        pStepOverStackSize := 0;
                    END;
                END;

            'H':
                HeapCmd;

            'I':
                BEGIN
                IF GetPromptedValue(AtStr(
                                     'Inspect what object [hex handle, or decimal stack level #]?: '
                                          ), asDecimal, asHex, true, gotSymbol) THEN
                    IF (asDecimal >= 0) & (asDecimal < 100) & NOT gotSymbol THEN
                        ShowFields(GetRcvrAtLevel(asDecimal, pLink), true)
                    ELSE
                        ShowFields(TObject(asHex), true);
                END;

            'L':
                BEGIN
                IF GetPromptedNumber(AtStr('Local variables of procedure [stack level #]?: '),
                                     asDecimal, asHex) THEN
                    IF asDecimal <> - 1 THEN
                        ShowLocals(asDecimal, pLink);
                END;

            'M':
                IF pMoreMem = - 1 THEN
                    WriteLn('There is no more to show.')
                ELSE IF pMoreMem = 0 THEN
                    ShowStack
                ELSE
                    ShowMemory(pMoreMem, 16);

            {$IFC IncludeDisassembler}
            'µ':
                IF pMoreMem = - 1 THEN
                    WriteLn('There is no more to show.')
                ELSE
                    ShowDisasmMemory(pMoreMem, 16);
            {$EndC}
            'O':
                BEGIN
                pQuietOutput := FALSE;
                str := GetPromptedString(AtStr('Redirect to file?: '), RedirectHelpProc);
                IF str <> '' THEN
                    pQuietOutput := GetPromptedChar(AtStr('Disable trace in debug window'),
                                                    AtStr('NY'), stdHelpProc) = 'Y';

                IF pDebugView <> NIL THEN
                    error := pDebugView.Redirect(0, @str);
                IF error <> noErr THEN
                    WriteLn('Error redirecting output = ', error: 1);

                gReportTime := pQuietOutput;
                END;

            'P':
                BEGIN
                IF GetPromptedNumber(AtStr('Parameters of procedure [stack level #]?: '), asDecimal,
                                     asHex) THEN
                    IF asDecimal <> - 1 THEN
                        ShowParameters(asDecimal, pLink);
                END;

            {$Ifc qPerform}
            'π':
                PerfCmd;
            {$Endc}

            'Q':
                IF GetPromptedChar(AtStr('Exit to shell.  Are you sure'), AtStr('NY'),
                   stdHelpProc) = 'Y' THEN               { erase prompt }
                    BEGIN
                    { Be kind to those with TApplication.Close routines }
                    IF pSavedState.gApplication <> NIL THEN
                        gApplication := pSavedState.gApplication;
                    ExitToShell;
                    END;

            'R':
                ShowRecent;

            'S':
                BEGIN
                nextLevel := 0;
                nextFrame := pLink;
                pNextPC := ppc;
                ShowStack;
                END;

            'ß':
                BEGIN
                { Get ready to blow out of debugger }
                IF GetPromptedNumber(AtStr('Error to signal with Failure?: '), asDecimal,
                   asHex) THEN
                    BEGIN
                    error := asDecimal;
                    IF GetPromptedNumber(AtStr('Message to signal with Failure?: '), asDecimal,
                                         asHex) THEN
                        BEGIN
                        message := asDecimal;
                        gReportNext := FALSE;

                        { Blow }
                        Failure(error, message);
                        END;
                    END;
                END;

            'T':
                BEGIN
                pTraceToggle := NOT pTraceToggle;
                gTracing := pTraceToggle & pTraceEnabled;
                ShowStatus;
                END;

            'W':
                WindCmd;

            'X':
                ToggleCmd;

        END;
        END;

    IF (NOT gSingleStep) & (pStepOverStackSize = 0) & (NOT gInBackground) THEN
        HiliteMenu(0);
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

PROCEDURE MADebuggerMainEntry(aWhich: ZT;
                              aPLink, aPpc: Longint);

    VAR
        i:                    INTEGER;
        forgotSuccess:        BOOLEAN;
        aWho:                MAName;
        pc:                 Longint;

    BEGIN
    IF NOT pCanEnterDebugger THEN                        { debugger is not re-entrant. But give user
                                                         a fighting chance }
        DebugStr('Re-entering the MacApp debugger which is not re-entrant. Be careful!')
    ELSE
        pCanEnterDebugger := FALSE;

    { make the reason we're here available to other procs }
    which := aWhich;
    pLink := aPLink;
    ppc := aPpc;

    pRecentIndex := BAND(pRecentIndex + 1, kRecent);    { modulo kRecent }
    WITH pRecentPC[pRecentIndex] DO
        BEGIN
        thePC := LongIntPtr(ppc)^;
        theZT := which;
        END;

    IF gMastReport THEN
        CheckFreeMasters
    ELSE
        pMasters := - 1;

    stkBreak := (which = tBegin) & ((pStackSpace > pBreakStack) | (pProcStack > pBrProcStack));
    stepBreak := (pStackSpace <= pStepOverStackSize);    { stop only if stack is same or less for
                                                         single stepping }

    IF pBreakCount > 0 THEN
        BEGIN
        GetProcName(ppc, className, procName);
        IF length(className) > 0 THEN
            Delete(procName, 1, length(className) + 1);

        FOR i := 1 TO pBreakCount DO
            BEGIN
            pAtBreak := ((length(pBreakClass[i]) = 0) | (pBreakClass[i] = className)) & (
                        (length(pBreakProc[i]) <> 0) & (pBreakProc[i] = procName));
            IF pAtBreak THEN
                LEAVE;
            END;
        END
    ELSE
        pAtBreak := stkBreak | stepBreak;

    waiting := gSingleStep | pAtBreak | (which >= tProgBreak) | IsUserBreak;

    { Check to see if we have too few calls to Success when leaving a procedure. This might be
    the case if the user forgot to make the call or it was missed and the handler is on the stack,
    which it usually (??? always) is. }
    forgotSuccess := ((which = tEnd) | (which = tExit)) & (StripLong(LongIntPtr(pLink)^) >=
                     StripLong(gTopHandler));
    IF forgotSuccess THEN
        BEGIN
        WriteLn(
         'You''re leaving a routine without calling Success for a handler that will be destroyed.'
                );
        pc := gTopHandler^.failPC;
        GetMethodName(Longint(@pc), aWho);
        WriteLn('Failure handler is: ', aWho);
        waiting := true;
        END;

    IF gTracing | gReportNext | waiting THEN
        BEGIN
        IF pQuietOutput & NOT waiting THEN
            pDebugView.ForceOutput(WrForceOff, WrForceUnchanged)
        ELSE
            pDebugView.ForceOutput(WrForceOn, WrForceUnchanged); { force output to window }

        IF gReportNext & (length(gReportInfo) <> 0) THEN
            BEGIN
            WriteLn(gReportInfo);
            gReportInfo := '';
            END;

        IF TrcEnable(true) THEN;

        IF NOT waiting & gReportTime THEN
            Write(TickCount: 10, ': ');

        IF pAtBreak THEN
            BEGIN
            IF stkBreak THEN
                Write('(stack space) ');
            Write('broke at ');
            END
        ELSE IF gReportNext THEN
            Write('@ ')
        ELSE IF waiting THEN
            Write('stopped at ');

        GetFrameInfo(pLink, ppc, callerFrame, itsFrame, receiver, className, procName, rcvrHandle,
                     rcvrClass, segNum);
        ShowWhere;

        IF waiting THEN
            BEGIN
            CallEnter(true, pEnterProc);

            {$Ifc qPerform}
            oldState := DebugPerfMonitor(FALSE);
            {$Endc}

            WithHideFromMacAppDo(DoWaiting, FullHide);

            CallEnter(FALSE, pEnterProc);

            {$Ifc qPerform}
            IF DebugPerfMonitor(oldState) THEN;
            {$Endc}
            END;

        pDebugView.EndForce;

        END;

    gReportNext := FALSE;

    pCanEnterDebugger := true;

    END;

{--------------------------------------------------------------------------------------------------}
{$S Main}
{$Push} {$Z+} {$%+}

PROCEDURE %_BP;

    VAR
        OldA5:                Longint;

    BEGIN
    OldA5 := SetCurrentA5;                                {}
    IF pCanEnterDebugger THEN
        BEGIN
        pStackSpace := ord(GetCurStackBase) - ord(GetCurStackTop);
        IF pStackSpace > gMaxStackDepth THEN
            gMaxStackDepth := pStackSpace;

        pProcStack := LongIntPtr(GetCurStackFramePtr)^ - Longint(GetCurStackFramePtr) - 8;

        MADebuggerMainEntry(tBegin, Ord4(GetCurStackFramePtr), Ord4(GetCurStackFramePtr) + 4);
        END;
    OldA5 := SetA5(OldA5);                                {}
    END;
{$Pop}

{--------------------------------------------------------------------------------------------------}
{$S Main}
{$Push} {$Z+} {$%+}

PROCEDURE %_EP;

    VAR
        OldA5:                Longint;

    BEGIN
    OldA5 := SetCurrentA5;                                {}
    IF pCanEnterDebugger THEN
        BEGIN
        pStackSpace := ord(GetCurStackBase) - ord(GetCurStackTop);
        MADebuggerMainEntry(tEnd, Ord4(GetCurStackFramePtr), Ord4(GetCurStackFramePtr) + 4);
        END;
    OldA5 := SetA5(OldA5);                                {}
    END;
{$Pop}

{--------------------------------------------------------------------------------------------------}
{$S Main}
{$Push} {$Z+} {$%+}

PROCEDURE %_EX;

    VAR
        OldA5:                Longint;

    BEGIN
    OldA5 := SetCurrentA5;                                {}
    IF pCanEnterDebugger THEN
        BEGIN
        pStackSpace := ord(GetCurStackBase) - ord(GetCurStackTop);
        MADebuggerMainEntry(tExit, Ord4(GetCurStackFramePtr), Ord4(GetCurStackFramePtr) + 4);
        END;
    OldA5 := SetA5(OldA5);                                {}
    END;
{$Pop}

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

PROCEDURE EnterMacAppDebugger;                            { called by ProgramBreak in UOBJECT }
    VAR
        notADummy:            Longint;

    BEGIN
    notADummy := LongIntPtr(Ord4(GetCurStackFramePtr))^;{ they called ProgramBreak called
                                                         EnterMacAppDebugger: skip a level }
    MADebuggerMainEntry(tProgBreak, notADummy, notADummy + 4);
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}
{$Push} {$Z+}

FUNCTION GetErrTxt(errorCode: INTEGER): Str255;

    BEGIN
    GetIndString(GetErrTxt, 252, errorCode);
    END;
{$Pop}

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}
{$Push} {$Z+}

VAR
    e:                    Str255;

PROCEDURE DebugException(errorCode: INTEGER);
{ 68000 exceptions (code 901-910) and SysError calls }

    CONST
        kUnInitStorage1     = $72677267;                { Pascal provided uninited storage }
        kUnInitStorage2     = $67726772;                { odd byte boundary of above }
        kDebugHandleInit    = $F3F3F3F3;                { Handles are inited to this in MacApp® }
        kDebugPtrInit        = $F5F5F5F5;                { Pointers are inited to this in MacApp® }
        kDebugObjInit        = $F1F1F1F1;                { Objects are inited to this in MacApp® }

    VAR
        notADummy:            Longint;
        accessAddr:         Longint;
        extras:             INTEGER;
        OldA5:                Longint;
        saveResLoad:        BOOLEAN;
        saveResFile:        INTEGER;

    BEGIN
    OldA5 := SetCurrentA5;                                {}
    saveResLoad := GetResLoad;
    SetResLoad(TRUE);
    saveResFile := MAUseResFile(gApplicationRefNum);

    notADummy := ord(@notADummy) + 78;                    { Where to leave continuation address =
                                                         dummy4+link4+pc4+arg2+16*reg4 }
    LongIntPtr(notADummy)^ := pSysErrPatch.oldTrapAddr; { Tentative value (worst case & disk
                                                         inserts) }

    IF (errorCode = - 127) |                            { Old menu not found. }
       (errorCode = - 126) |                            { Old menu bar not found. }
       (errorCode = 30) |                                { "Please insert the disk". }
       ((errorCode >= 50) & (errorCode <= 69)) |        { SADE }
       ((errorCode >= $7FF0) & (errorCode <= $7FFF))    { Reserved for system or app use. }
       THEN
        BEGIN
        { Drop through }
        END
    ELSE
        BEGIN
        IF NOT pCanEnterDebugger THEN
            DebugStr('Re-entering the MacApp exception handler which is not re-entrant. Be careful!'
                     );

        { If an error happens in the debugger, give up! }
        InstallInterceptors(FALSE);

        EmptyHandle(pReserve);                            { we need all the space we can get }

        WriteLn;

        extras := 0;
        accessAddr := 0;
        IF (errorCode DIV 100) = 9 THEN                 { 900-9xx are 68000 exceptions, not SysErr
                                                         calls }
            BEGIN
            { Where to go after this procedure returns }
            CASE (errorCode - 900) * sizeof(Longint) OF
                exBusError:
                    Handle(notADummy)^ := pOldexBusError;
                exAddressError:
                    Handle(notADummy)^ := pOldexAddressError;
                exIllegalInst:
                    Handle(notADummy)^ := pOldexIllegalInst;
                exZeroDivide:
                    Handle(notADummy)^ := pOldexZeroDivide;
                exCheck:
                    Handle(notADummy)^ := pOldexCheck;
                exOverflow:
                    Handle(notADummy)^ := pOldexOverflow;
                exLineF:
                    Handle(notADummy)^ := pOldexLineF;
            END;

            IF errorCode = 900 THEN
                Write('NMI Button: ')
            ELSE
                Write('Exception #', errorCode - 900: 1, '  ');
            errorCode := errorCode - 901;
            { Thanks to Rob Hawley for improvements to the following code }
            IF (errorCode = 1) | (errorCode = 2) | (errorCode = 3) | (errorCode = 6) THEN { Bus
                   error or Address error }
                BEGIN
                { 68000 and 68020 have different exception stack frames }
                IF NOT (qNeedsMC68020 | qNeedsMC68030) & (gConfiguration.processor = env68000) THEN
                    BEGIN
                    extras := 8;                        { 68000 precedes status and PC with 4 words
                                                         }
                    accessAddr := LongIntPtr(notADummy + 6)^; { which includes the access address }
                    END
                ELSE
                    BEGIN
                    extras := 0;                        { no extra stack frame data before status
                                                         reg & PC }
                    wrlblptr('exception frame Addr', LongIntPtr(notADummy + 4));
                    WriteLn;
                    IF (errorCode = 1) | (errorCode = 2) THEN
                        BEGIN
                        wrlblptr('PC', LongIntPtr(notADummy + 4 + 2)^);
                        WriteLn;
                        accessAddr := LongIntPtr(notADummy + 20)^; { Must add 16 - 4 to get
                                                                    offending address}
                        END
                    ELSE
                        accessAddr := LongIntPtr(notADummy + 4 + 2)^; {Same as PC}
                    END
                END
            END
        ELSE
            Write('SysErr ID = ', errorCode: 1, '  ');

        CASE errorCode OF                                { All SysError argument values except where
                                                         indicated }
            0..28:
                e := GetErrTxt(errorCode + 1);
            33:
                e := GetErrTxt(30);
            { 30, 31: ...Disk insert... }
            41:
                e := GetErrTxt(31);
            42:
                e := GetErrTxt(32);
            51:
                e := GetErrTxt(33);
            81:
                e := GetErrTxt(34);
            84:
                e := GetErrTxt(35);
            85:
                e := GetErrTxt(36);
            86:
                e := GetErrTxt(37);
            100:
                e := GetErrTxt(38);
            MAXINT:
                e := GetErrTxt(39);
            OTHERWISE
                IF (32 <= errorCode) & (errorCode <= 53) THEN
                    e := GetErrTxt(40)
                ELSE
                    e := GetErrTxt(41);
        END;

        WriteLn(e);
        IF accessAddr <> 0 THEN
            BEGIN
            Write('Bad address was: ');
            WritePtr(accessAddr);
            WriteLn;
            IF accessAddr = kUnInitStorage1 THEN
                WriteLn('Appears to be Pascal provided uninitialized storage.')
            ELSE IF accessAddr = kUnInitStorage2 THEN
                WriteLn(
                      'Appears to be Pascal provided uninitialized storage at an odd byte boundary.'
                        )
            ELSE IF accessAddr = kDebugHandleInit THEN
                WriteLn('Appears to be Handle contents initialized by debugging.')
            ELSE IF accessAddr = kDebugPtrInit THEN
                WriteLn('Appears to be Pointer contents initialized by debugging.')
            ELSE IF accessAddr = kDebugObjInit THEN
                WriteLn('Appears to be uninitialized instance variable.')
            END;
        gApplication.Beep(30);                            { 1/2 second }

        MADebuggerMainEntry(tSysError, Ord4(GetCurStackFramePtr), Ord4(GetCurStackFramePtr) + 2 + extras);
        InstallInterceptors(true);
        END;
    IF MAUseResFile(saveResFile) = 0 THEN ;
    SetResLoad(saveResLoad);
    OldA5 := SetA5(OldA5);
    END;
{$Pop}



{--------------------------------------------------------------------------------------------------}
{$Push} {$IFC qTrace} {$D+} {$ENDC}
{$W+}
{$R-}
{$Init-}
{$OV-}
{$S MADebugger}

PROCEDURE aVBLTask;

    CONST
        kVBLDelay            = 15;                        { Ticks before checking }
        theOffset            = sizeof(Longint) * 2;

    VAR
        aKeyMap:            KeyMap;
        oldState:            INTEGER;

    BEGIN

{ Set up application's A5.
  Our A5 is prepended to the QElem which is pointed at by A0 }

    WITH pVBLInfo DO
        pVBLInfo.aQElemWithA5.OldA5 := SetA5(VBLInfoPtr(GetParmBlockPtr - theOffset)^.aQElemWithA5.
                                             A5);

    oldState := IntegerPtr(JournalFlag)^;
    IntegerPtr(JournalFlag)^ := 0;                        { turn off journaling }
    GetKeys(aKeyMap);
    IntegerPtr(JournalFlag)^ := oldState;

    IF aKeyMap[59] & aKeyMap[55] & aKeyMap[56] & aKeyMap[58] & pCanEnterDebugger THEN
        MADebuggerMainEntry(tVBL, Ord4(GetCurStackFramePtr), Ord4(GetCurStackFramePtr) + 4);

    { always Reset the vblCount }
    WITH pVBLInfo DO
        BEGIN
        aQElemWithA5.q.vblQElem.vblCount := kVBLDelay;
        IF SetA5(aQElemWithA5.OldA5) = 0 THEN;            { discard the function result }
        END;

    END;
{$Pop}

{--------------------------------------------------------------------------------------------------}
{$S MAInit}

PROCEDURE VBLInstall;

    CONST
        kVBLDelay            = 15;                        { Ticks before checking }

    BEGIN
    IF pInterceptExceptionVectors THEN
        WITH pVBLInfo DO
            BEGIN
            { Setup the VBL task }
            WITH aQElemWithA5.q.vblQElem DO
                BEGIN
                qType := ord(vType);
                vblAddr := @aVBLTask;
                vblCount := kVBLDelay;
                vblPhase := 0;
                END;
            aQElemWithA5.A5 := Longint(GetA5);
            { This will make the A5 world available to the VBL task }

            { Install the VBL task }
            FailOSErr(VInstall(@aQElemWithA5.q));
            END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

PROCEDURE VBLRemove;

{ removes the VBL task }

    VAR
        e:                    OSErr;

    BEGIN
    IF pInterceptExceptionVectors THEN
        e := VRemove(@pVBLInfo.aQElemWithA5.q);         { Discard error }
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

PROCEDURE DebugEndForce;

    BEGIN
    IF pDebugView <> NIL THEN
        pDebugView.EndForce;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

PROCEDURE DebugForceOutput(DebugToWindow, DebugToFile: DebugForceOptions);

    BEGIN
    IF pDebugView <> NIL THEN
        pDebugView.ForceOutput(WrForceOptions(DebugToWindow), WrForceOptions(DebugToFile));
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

FUNCTION DebugRedirect(vRefnum: INTEGER;                {CONST}
                       fileName: StringPtr): OSErr;

    BEGIN
    IF pDebugView <> NIL THEN
        DebugRedirect := pDebugView.Redirect(vRefnum, fileName)
    ELSE
        DebugRedirect := noErr;                         {!!! think of an error to return }
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

PROCEDURE AddObjectToInspector(obj: TObject);
    EXTERNAL;

PROCEDURE DoToSubView(view: TView);

    BEGIN
    IF view.fSubViews <> NIL THEN
        AddObjectToInspector(view.fSubViews);
    AddObjectToInspector(view);
    view.EachSubView(DoToSubView);
    END;

PROCEDURE InitUDebugAfterIApplication;
{ Call this once at the end of IApplication to finish initialization of the debugger. }

    BEGIN
    { do the following for each debug window }
    pDebugWindow.fNextHandler := gApplication;
    InstallIfPrintHandler(gPrintHandler, pDebugView);

    {$IFC qDebugTheDebugger}
    DoToSubView(pDebugWindow);
    {$ENDC}
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

PROCEDURE DebugShowTranscriptWindow;
{ Call this proc from macApp to show the window }

    BEGIN
    IF pDebugWindow <> NIL THEN
        pDebugWindow.Open;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

FUNCTION DebugCapture(captureProc: ProcPtr): ProcPtr;
{ Install an alternative capture proc, which will get called for every
writeln. It should have the same interface as AddText. You will
probably want to set gWrToWindow to FALSE to inhibit output to the
window at the same time. Pass NIL to remove any capture proc. }

    BEGIN
    DebugCapture := fCaptureProc;
    fCaptureProc := captureProc;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

FUNCTION DebugTranscriptWidth: INTEGER;
{ Returns number of characters per line in current transcript window }

    BEGIN
    DebugTranscriptWidth := pDebugView.fCols;
    END;

{$EndC qDebug}
{--------------------------------------------------------------------------------------------------}
{$S Main}

FUNCTION DebugCanReadLn: BOOLEAN;
{ Returns True if you can readln to the user }

    BEGIN
    DebugCanReadLn := (pDebugView <> NIL) & pDebugView.fWrToWindow & pUDebugInitialized;
    END;

{--------------------------------------------------------------------------------------------------}
{$S Main}

FUNCTION DebugCanWriteLn: BOOLEAN;
{ Returns True if you can writeln to the user }

    BEGIN
    DebugCanWriteLn := (pDebugView <> NIL) & pUDebugInitialized;
    END;

{--------------------------------------------------------------------------------------------------}
{$S Main}

PROCEDURE GetCallersMethodName(VAR s: MAName);

    BEGIN
    GetMethodName(LongIntPtr(GetCurStackFramePtr)^ + 4, s); { report about our caller's caller }
    END;

{--------------------------------------------------------------------------------------------------}
{$S Main}

PROCEDURE GetMethodName(ppc: Longint;
                        VAR s: MAName);
{ GetMethodName returns the name of the method (or procedure) in
which ppc points. }

    BEGIN
    GetProcName(ppc, discardStr, s);
    END;

{--------------------------------------------------------------------------------------------------}
{$S Main}

PROCEDURE GetProcName(ppc: Longint;
                      VAR className, procName: MAName);
{ GetProcName returns the name of the procedure or function in
which ppc points.  If it is in a method, then it return's
the name of the method's class in className. }

    VAR
        pc, nextPC, limit:    Ptr;
        index:                INTEGER;

    BEGIN
    pc := Handle(ppc)^;
    IF (ord(pc) <> 0) & NOT Odd(ord(pc)) THEN
        BEGIN
        limit := Ptr(ord(pc) + 32767);
        WHILE (endOfModule(pc, limit, @procName, nextPC) = NIL) DO
            BEGIN
            IF ord(pc) >= ord(limit) THEN
                BEGIN
                className := '';
                procName := '';
                LEAVE;
                END
            ELSE
                pc := Ptr(ord(pc) + 2);
            END;

        index := pos('.', procName);
        IF index <> 0 THEN
            BEGIN
            className := copy(procName, 1, index - 1);
            END
        ELSE
            className := '';
        END
    ELSE
        BEGIN
        className := '';
        procName := '';
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

FUNCTION TrcEnable(okToTrace: BOOLEAN): BOOLEAN;
{ Control whether tracing from %_BP/%_EP/%_EX is enabled or not.  Set to false when the section
of code that you are using doesn't really need to be traced (like the inspector or debugger itself).}

    BEGIN
    TrcEnable := pTraceEnabled;
    pTraceEnabled := okToTrace;
    gTracing := pTraceToggle & pTraceEnabled;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

PROCEDURE IDUDebug;
{ Writeln UDebug compile time. }

    BEGIN
    WRITELN('UDebug of 14 Feb 90 (Valentine''s Day), Compiled on ', COMPDATE, ' @ ', COMPTIME);
    END;